Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/ChangeLog
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/ChangeLog	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/ChangeLog	(revision 4775)
@@ -0,0 +1,626 @@
+This file describes what tags were created and why
+================================================================================
+Originator: tcraig
+Date: Oct 22 2012
+Model: oasis3-mct
+Version: oasis3-mct_121022
+
+- add check for coupling comms with no tasks, now abort instead of hangs 
+  (redmine #475)
+- modify mapping initialization to separate mask/area reading from map read, 
+  add AVred attribute to mapping datatype (redmine #394)
+	
+M      lib/psmile/src/mod_oasis_coupler.F90
+M      lib/psmile/src/mod_oasis_method.F90
+================================================================================
+Originator: tcraig
+Date: July 25 2012
+Model: oasis3-mct
+Version: oasis3-mct_120724
+
+- update kinfo return codes for get and put calls
+- modify conserv to support bfb on different pes, set by
+  optional argument to CONSERV namcouple (bfb or opt), 
+  default is now bfb.
+- fix bug asssociated with nrouter count (not answer changing)
+- add prism_method_createcouplcomm and change setlocalcomm interface
+  name to setcouplcomm.
+- update namcouple init to read namcouple on root pe first then other
+  pes.  improves error detection.
+- update psmile Makefile dependencies
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_getput_interface.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_oasis.F90
+M      lib/psmile/src/Makefile
+
+================================================================================
+Originator: tcraig
+Date: July 11 2012
+Model: oasis3-mct
+Version: oasis3-mct_120711
+
+- add prism_method_setlocalcomm to allow components to reset the
+  coupling communicator to support coupling on a subset of pes
+- minor refactor of coupling initialization to support coupling
+  on subset of pes
+- add pes_coupling example test case
+- add a few additional debug statements
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_sys.F90
+M      lib/psmile/src/mod_prism.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_oasis.F90
+M      lib/psmile/src/mod_prism_part.F90
+	
+================================================================================
+Originator: tcraig
+Date: June 12 2012
+Model: oasis3-mct
+Version: oasis3-mct_120612
+
+ - add run-time checking that NFIELDS is consistent with rest of namcouple.
+   if NFIELDS is too small or too large, the model will stop.
+ - remove requirement that grid nx and ny be set in namcouple, it's now optional
+   (again).
+ - remove requirement that SEQMODE be set properly in namcouple, it's now ignored
+   as it plays no role. (accidently removed after tag 120425)
+ - get all test cases running on corail
+	
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_part.F90
+M      lib/psmile/src/mod_prism_io.F90
+================================================================================
+Originator: tcraig
+Date: April 25 2012
+Model: oasis3-mct
+Version: oasis3-mct_120425
+
+- remove aborts due to inconsistent SEQMODE value vs SEQ values.  the SEQMODE
+  input is not needed.
+
+M      lib/psmile/src/mod_prism_namcouple.F90
+================================================================================
+Originator: tcraig
+Date: April 24 2012
+Model: oasis3-mct
+Version: oasis3-mct_120424
+
+- update loctrans restart files logic so restarts are only written
+  in the last coupling period of the run for the field
+
+M      lib/psmile/src/mod_prism_advance.F90
+================================================================================
+Originator: tcraig
+Date: April 11 2012
+Model: oasis3-mct
+Version: oasis3-mct_120411
+
+- add scrip to build system, update Makefiles
+- add capability to use SCRIPR in namcouple for a subset
+  of scrip options.  bilinear and conserve first order tested in tc3a.
+- use oasis3 based scrip version for oasis3-mct.  remove
+  oasis3 low level code dependencies like "mod" modules.  replace 
+  as needed with local implementations.  very minor changes.  otherwise,
+  scrip should be intact as in oasis3.
+- call into scrip from mod_prism_coupler, in particular, grid_init and
+  scrip to generate a mapping file.  later, that file is read into the
+  mct sparse matrix mapping datatype as if it had been generated offline.
+	
+M      lib/scrip/src/rotations.F90
+M      lib/scrip/src/gradient.f
+M      lib/scrip/src/scriprmp.F
+M      lib/scrip/src/timers.f
+M      lib/scrip/src/netcdf.F
+M      lib/scrip/src/remap_bilinear_reduced.f
+M      lib/scrip/src/kinds_mod.f
+M      lib/scrip/src/grids.f
+M      lib/scrip/src/remap_bilinear.f
+M      lib/scrip/src/vector.F90
+M      lib/scrip/src/corners.F
+M      lib/scrip/src/gradient_bicubic.f
+M      lib/scrip/src/scrip.F
+M      lib/scrip/src/remap_bicubic_reduced.F90
+M      lib/scrip/src/Makefile
+M      lib/scrip/src/iounits.f
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_io.F90
+M      lib/psmile/src/Makefile
+M      util/make_dir/TopMakefileOasis3
+M      examples/tutorial/run_tutorial
+M      examples/tutorial/Makefile
+================================================================================
+Originator: tcraig
+Date: April 3 2012
+Model: oasis3-mct
+Version: oasis3-mct_120403
+
+- fix restart issues with LOCTRANS
+- fix restart issues with LOCTRANS and lag, tested in tc3a
+- some initial mods to support map generation using scrip 
+
+M      lib/psmile/src/mod_prism_data.F90
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_io.F90
+================================================================================
+Originator: tcraig
+Date: March 31 2012
+Model: oasis3-mct
+Version: oasis3-mct_120331
+
+- add prism_get_intracomm and prism_get_intercomm and test in tc3a testcase
+	
+M      lib/psmile/src/mod_prism_data.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism.F90
+M      lib/psmile/src/mod_oasis.F90
+M      lib/psmile/src/Makefile
+================================================================================
+Originator: tcraig
+Date: March 23 2012
+Model: oasis3-mct
+Version: oasis3-mct_120323
+
+- remove compilation of oasis executable and use of oasis
+  central coupler in examples.  oasis src still in repository.
+
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      util/make_dir/TopMakefileOasis3
+M      examples/tutorial/run_tutorial
+================================================================================
+Originator: tcraig
+Date: March 20 2012
+Model: oasis3-mct
+Version: oasis3-mct_120320
+
+- Update grids writing to prevent multiple pes writing at the same time
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism_grid.F90
+M      lib/psmile/src/Makefile
+	
+================================================================================
+Originator: tcraig
+Date: March 15 2012
+Model: oasis3-mct
+Version: oasis3-mct_120315
+
+- generalize prism_debug implementation, use nlogprt in namcoupler
+- add prism_set_debug and prism_get_debug interfaces to update
+  prism_debug at runtime
+- add enter, exit, and notes to create calling tree
+- add restart capability for loctrans operations
+- add prism_io_read_array, prism_io_write_array
+- update oasis interface names, remove proto
+	
+M      lib/psmile/src/mod_prism_data.F90
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_sys.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism.F90
+M      lib/psmile/src/mod_prism_timer.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_ioshr.F90
+M      lib/psmile/src/mod_prism_mpi.F90
+M      lib/psmile/src/mod_prism_grid.F90
+M      lib/psmile/src/mod_prism_getput_interface.F90
+M      lib/psmile/src/mod_prism_var.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_parameters.F90
+M      lib/psmile/src/mod_oasis.F90
+M      lib/psmile/src/mod_prism_part.F90
+M      lib/psmile/src/mod_prism_string.F90
+M      lib/psmile/src/mod_prism_io.F90
+M      lib/psmile/src/Makefile
+M      lib/psmile/src/mod_prism_kinds.F90
+M      examples/tutorial/run_tutorial
+M      examples/tutorial/data_oasis3/namcouple
+================================================================================
+Originator: tcraig
+Date: Jan 29 2012
+Model: oasis3-mct
+Version: oasis3-mct_120129
+
+ - add bfb, sum, opt mapping options
+ - add support for CHECKIN, CHECKOUT
+ - add support for BLASOLD, BLASNEW for constants only
+ - add mapchk example for ORANGE decomp and all map options
+ - add support for MPI INIT/FINALIZE calls in models
+ - update testcases
+
+	M      lib/psmile/src/mod_prism_coupler.F90
+	M      lib/psmile/src/mod_prism_method.F90
+	M      lib/psmile/src/mod_prism_namcouple.F90
+	M      lib/psmile/src/mod_prism_advance.F90
+	M      examples/tutorial/run_tutorial
+	M      examples/tutorial/data_oasis3/namcouple
+	A      examples/mapchk
+	A      examples/mapchk/model2.F90
+	A      examples/mapchk/go.csh
+	A      examples/mapchk/decomp_def.F90
+	A      examples/mapchk/routine_hdlerr.F90
+	A      examples/mapchk/read_grid_irreg.F90
+	A      examples/mapchk/run_mapchk
+	A      examples/mapchk/read_dim_irreg.F90
+	A      examples/mapchk/read_grid_reg.F90
+	A      examples/mapchk/data_oasis3
+	A      examples/mapchk/data_oasis3/rmp_torc_to_lmdz_BILINEA.nc
+	A      examples/mapchk/data_oasis3/rmp_lmdz_to_torc_BILINEA.nc
+	A      examples/mapchk/data_oasis3/namcouple
+	A      examples/mapchk/data_oasis3/grid_model1.nc
+	A      examples/mapchk/data_oasis3/grid_model2.nc
+	A      examples/mapchk/data_oasis3/fdocn.nc
+	A      examples/mapchk/data_oasis3/postproc.out.base
+	A      examples/mapchk/data_oasis3/fdatm.nc
+	A      examples/mapchk/data_oasis3/cf_name_table.txt
+	A      examples/mapchk/function_sent.F90
+	A      examples/mapchk/oasis3_local_grid.F90
+	A      examples/mapchk/Makefile
+	A      examples/mapchk/read_dim_reg.F90
+	A      examples/mapchk/model1.F90
+	M      examples/restart/data_oasis3/namcouple
+	M      examples/tc3a/model2.F90
+	M      examples/tc3a/model3.F90
+	M      examples/tc3a/data_oasis3/namcouple
+	M      examples/tc3a/model1.F90
+	M      examples/tc3a/run_tc3a
+	
+================================================================================
+Originator: tcraig
+Date: Jan 24 2012
+Model: oasis3-mct
+Version: oasis3-mct_120124
+
+ - add mod_oasis and "oasis" parameters and interfaces, "prism" still allowed
+ - add restart test
+ - verify restart working for lags
+ - verify negative lag works and modify lag validation test to -dt < lag >= dt
+ - modify tc3a to test negative lag and oasis interfaces
+ - update some diagnostic output slightly
+ - update psmile Makefile dependencies
+ - change make build path to $(HOME)/oasis3-mct
+ - update tc3a M1FLD07 input file, verify "input" option works
+	
+M      lib/psmile/src/mod_prism_grid.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_parameters.F90
+A      lib/psmile/src/mod_oasis.F90
+M      lib/psmile/src/Makefile
+M      util/make_dir/make.intel_corail
+M      util/make_dir/make.inc
+M      examples/tutorial/run_tutorial
+A      examples/restart
+A      examples/restart/model2.F90
+A      examples/restart/model3.F90
+A      examples/restart/go.csh
+A      examples/restart/decomp_def.F90
+A      examples/restart/routine_hdlerr.F90
+A      examples/restart/flddiag.F90
+A      examples/restart/read_dim_irreg.F90
+A      examples/restart/data_oasis3
+A      examples/restart/data_oasis3/rmp_torc_to_lmdz_BILINEA.nc
+A      examples/restart/data_oasis3/rmp_lmdz_to_torc_BILINEA.nc
+A      examples/restart/data_oasis3/namcouple
+A      examples/restart/data_oasis3/grid_model1.nc
+A      examples/restart/data_oasis3/grid_model2.nc
+A      examples/restart/data_oasis3/grid_model3.nc
+A      examples/restart/data_oasis3/rst1.nc
+A      examples/restart/data_oasis3/rst2.nc
+A      examples/restart/data_oasis3/rst3.nc
+A      examples/restart/data_oasis3/M1FLD07_input3.nc
+A      examples/restart/data_oasis3/cf_name_table.txt
+A      examples/restart/read_dim_reg.F90
+A      examples/restart/read_grid_irreg.F90
+A      examples/restart/run_restart
+A      examples/restart/read_grid_reg.F90
+A      examples/restart/function_sent.F90
+A      examples/restart/oasis3_local_grid.F90
+A      examples/restart/Makefile
+A      examples/restart/model1.F90
+M      examples/tc3a/model2.F90
+M      examples/tc3a/data_oasis3/namcouple
+A      examples/tc3a/data_oasis3/M1FLD07_input2.nc
+M      examples/tc3a/run_tc3a
+	
+================================================================================
+Originator: tcraig
+Date: Dec 14 2011
+Model: oasis3-mct
+Version: dev_tcraig_111214
+
+- add conserv methods
+- fix/add grids and area in model1/model2 fields
+- update grids writing to use grids.nc, areas.nc, masks.nc as output files
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_data.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_grid.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_parameters.F90
+M      lib/psmile/src/Makefile
+M      lib/psmile/src/mod_prism_io.F90
+M      examples/tc3a/model2.F90
+M      examples/tc3a/model3.F90
+M      examples/tc3a/data_oasis3/namcouple
+A  +   examples/tc3a/data_oasis3/grids.nc.0
+D      examples/tc3a/data_oasis3/grids.nc
+A  +   examples/tc3a/data_oasis3/masks.nc.0
+D      examples/tc3a/data_oasis3/masks.nc
+M      examples/tc3a/model1.F90
+================================================================================
+Originator: tcraig
+Date: Nov 17 2011
+Model: oasis3-mct
+Version: dev_tcraig_111117
+
+- add input capability
+- turn off pio build and use of pio lib
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_io.F90
+M      src/Makefile
+M      ChangeLog
+M      util/make_dir/TopMakefileOasis3
+M      examples/tutorial/Makefile
+M      examples/tc3a/data_oasis3/namcouple
+M      examples/tc3a/Makefile
+A      examples/HR_tutorial/data_oasis3/cf_name_table.txt
+M      examples/HR_tutorial/Makefile
+================================================================================
+Originator: tcraig
+Date: Nov 4 2011
+Model: oasis3-mct
+Version: dev_tcraig_111104
+
+ - add restart capability
+ - make prism_coupler datatypes pointers
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_method.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_io.F90
+M      examples/tc3a/model2.F90
+M      examples/tc3a/model3.F90
+M      examples/tc3a/data_oasis3/namcouple
+A      examples/tc3a/data_oasis3/rst1.nc
+A      examples/tc3a/data_oasis3/rst2.nc
+A      examples/tc3a/data_oasis3/rst3.nc
+M      examples/tc3a/model1.F90
+================================================================================
+Originator: tcraig
+Date: Oct 26 2011
+Model: oasis3-mct
+Version: dev_tcraig_111025
+
+ - update control logic
+
+A      doc/oasis3-mct.txt
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_getput_interface.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_parameters.F90
+M      lib/psmile/src/mod_prism_io.F90
+M      examples/tc3a/data_oasis3/namcouple
+M      examples/tc3a/model1.F90
+================================================================================
+Originator: tcraig
+Date: Oct 23 2011
+Model: oasis3-mct
+Version: dev_tcraig_111024
+
+ - update prism_io_write_avfbf and read_avfbf to create timeseries of data,
+   should be usable for both "OUTPUT" and "INPUT"
+ - extend methods to include EXPOUT, EXPORTED, IGNORED==EXPORTED, IGNOUT==EXPOUT,
+   OUTPUT.  still need to work on INPUT.  AUXILARY not supported in general.
+ - add proper 2d output capability of fields
+
+M      lib/psmile/src/mod_prism_coupler.F90
+M      lib/psmile/src/mod_prism_namcouple.F90
+M      lib/psmile/src/mod_prism_advance.F90
+M      lib/psmile/src/mod_prism_io.F90
+================================================================================
+Originator: tcraig
+Date: Oct 22 2011
+Model: oasis3-mct
+Version: dev_tcraig_111023
+
+- extend getput interfaces to r14, r18, r24
+- rename mod_prism_grids_writing.F90 to mod_prism_grid.F90
+- refactor mod_prism_grid so it stores grids, writes at terminate
+
+D      lib/psmile/src/mod_prism_grids_writing.F90
+M      lib/psmile/src/mod_prism.F90
+A  +   lib/psmile/src/mod_prism_grid.F90
+M      lib/psmile/src/mod_prism_getput_interface.F90
+M      lib/psmile/src/Makefile
+M      examples/tc3a/model3.F90
+================================================================================
+Originator: tcraig
+Date: Oct 22 2011
+Model: oasis3-mct
+Version: dev_tcraig_111022
+
+- add I/O capabilities (not pio)
+- add nx,ny,gridname to prism_part
+- write grid files (need to change files)
+- write field output (need logic)
+
+M      oasis3-mct/lib/psmile/src/mod_prism_data.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_coupler.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_grids_writing.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_sys.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_timer.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_method.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_namcouple.F90
+A      oasis3-mct/lib/psmile/src/mod_prism_ioshr.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_advance.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_parameters.F90
+M      oasis3-mct/lib/psmile/src/mod_prism_part.F90
+M      oasis3-mct/lib/psmile/src/Makefile
+A      oasis3-mct/lib/psmile/src/mod_prism_io.F90
+M      oasis3-mct/src/Makefile
+M      oasis3-mct/util/make_dir/make.intel_corail
+M      oasis3-mct/examples/tutorial/run_tutorial
+M      oasis3-mct/examples/tc3a/model3.F90
+M      oasis3-mct/examples/tc3a/run_tc3a
+================================================================================
+Originator: tcraig
+Date: Oct 18 2011
+Model: oasis3-mct
+Version: dev_tcraig_111018
+
+- port to corail
+- add pio lib (pio1_3_11)
+
+M      lib/mpp_io/src/Makefile
+A      lib/pio
+A      lib/pio/m4
+A      lib/pio/m4/acx_mpi.m4
+A      lib/pio/m4/pkg.m4
+A      lib/pio/m4/acx_hdf5.m4
+A      lib/pio/m4/netcdf.m4
+A      lib/pio/m4/ax_fc_version.m4
+A      lib/pio/m4/fortran.m4
+A      lib/pio/pio_msg_getput_callbacks.F90
+A      lib/pio/configure
+A      lib/pio/pionfwrite_mod.F90
+A      lib/pio/alloc_mod.F90
+A      lib/pio/pionfwrite_mod.F90.in
+A      lib/pio/piodarray.F90
+A      lib/pio/pio_nf_utils.F90
+A      lib/pio/pio_msg_callbacks.F90
+A      lib/pio/alloc_mod.F90.in
+A      lib/pio/pio_spmd_utils.F90.in
+A      lib/pio/pionfput_mod.F90
+A      lib/pio/README.config
+A      lib/pio/configure.ac
+A      lib/pio/pionfread_mod.F90
+A      lib/pio/calcdisplace_mod.F90
+A      lib/pio/rearrange.F90
+A      lib/pio/pio_utils.F90
+A      lib/pio/pionfput_mod.F90.in
+A      lib/pio/pio_types.F90
+A      lib/pio/iompi_mod.F90
+A      lib/pio/pio_mpi_utils.F90
+A      lib/pio/fdepends.awk
+A      lib/pio/piolib_mod.F90
+A      lib/pio/pio_kinds.F90
+A      lib/pio/pionfget_mod.F90.in
+A      lib/pio/Makefile
+A      lib/pio/pionfatt_mod.F90
+A      lib/pio/box_rearrange.F90.in
+A      lib/pio/pio_support.F90
+A      lib/pio/pio.F90
+A      lib/pio/pionfatt_mod.F90.in
+A      lib/pio/pio_support.F90.in
+A      lib/pio/pio_msg_getput_callbacks.F90.in
+A      lib/pio/calcdecomp.F90
+A      lib/pio/ionf_mod.F90
+A      lib/pio/pio_spmd_utils.F90
+A      lib/pio/pio_quicksort.F90
+A      lib/pio/pio_msg_mod.F90
+A      lib/pio/piodarray.F90.in
+A      lib/pio/README
+A      lib/pio/topology.c
+A      lib/pio/dtypes.h
+A      lib/pio/nf_mod.F90
+A      lib/pio/config.h.in
+A      lib/pio/genf90.pl
+A      lib/pio/Makefile.conf.in
+A      lib/pio/pionfget_mod.F90
+A      lib/pio/pionfread_mod.F90.in
+A      lib/pio/rearrange.F90.in
+A      lib/pio/box_rearrange.F90
+A      lib/pio/aclocal.m4
+A      lib/pio/iompi_mod.F90.in
+M      lib/psmile/src/Makefile
+A      util/make_dir/make.intel_corail
+A      util/make_dir/make.intel_corail.oasis4
+M      util/make_dir/TopMakefileOasis3
+M      util/make_dir/make.inc
+A      util/make_dir/make.pgi_cerfacs_tioman
+M      examples/tutorial/go.csh
+M      examples/tutorial/Makefile
+M      examples/tc3a/go.csh
+M      examples/tc3a/Makefile
+
+================================================================================
+Originator: tcraig
+Date: Sep 22 2011
+Model: oasis3-mct
+Version: dev_tcraig_110922	
+
+- add timing module, mod_prism_timer.F90, from oasis4 with mods
+- rename mod_kinds_model to mod_prism_kinds
+- update model1, model2, model3 to use flddiag to diagnose global sum of fields
+- modify tc3a example to use 3 models and run in parallel
+	
+	M       oasis3-mct/lib/mpp_io/src/mod_kinds_mpp.F90
+	M       oasis3-mct/lib/mpp_io/src/Makefile
+	M       oasis3-mct/lib/psmile/src/mod_prism_coupler.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_data.F90
+	D       oasis3-mct/lib/psmile/src/mod_kinds_model.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_sys.F90
+	A       oasis3-mct/lib/psmile/src/mod_prism_timer.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_method.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_namcouple.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_mpi.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_var.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_getput_interface.F90
+	D       oasis3-mct/lib/psmile/src/mod_prism_time.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_advance.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_parameters.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_part.F90
+	M       oasis3-mct/lib/psmile/src/mod_prism_string.F90
+	M       oasis3-mct/lib/psmile/src/Makefile
+	A  +    oasis3-mct/lib/psmile/src/mod_prism_kinds.F90
+	M       oasis3-mct/util/make_dir/COMP.err
+	M       oasis3-mct/util/make_dir/COMP.log
+	M       oasis3-mct/examples/tc3a/model2.F90
+	M       oasis3-mct/examples/tc3a/model3.F90
+	A       oasis3-mct/examples/tc3a/flddiag.F90
+	M       oasis3-mct/examples/tc3a/data_oasis3/namcouple
+	M       oasis3-mct/examples/tc3a/Makefile
+	M       oasis3-mct/examples/tc3a/model1.F90
+	M       oasis3-mct/examples/tc3a/run_tc3a
+================================================================================
+Originator: tcraig
+Date: Sep 21 2011
+Model: oasis3-mct
+Version: dev_tcraig_110921
+
+One-line: initial import of oasis3-mct based on oasis3 Sept 6 2011.
+
+  examples tc3a and tutorial run as configured
+  weights generation still unavailable
+  IO still unavailable
+
+ Add everything under oasis3-mct
+
+================================================================================
+Originator: tcraig
+Date: Sep 21 2011
+Model: oasis3-mct
+Version: dev_tcraig_110920
+
+One-line: initial import of trunk based on Sept 6 2011 version
+
+==============================================================================
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/.latex2html-init
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/.latex2html-init	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/.latex2html-init	(revision 4775)
@@ -0,0 +1,2 @@
+$INTERLACE=0;
+$ICONSERVER="http://www.cerfacs.fr/oa4web/oasis3-mct/icons"
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG0_Stepbystep_overview.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG0_Stepbystep_overview.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG0_Stepbystep_overview.tex	(revision 4775)
@@ -0,0 +1,181 @@
+\newpage
+\chapter{Introduction}
+\label{sec_step}
+
+In 1991, CERFACS started the development of
+a software interface to couple existing ocean and atmosphere numerical General
+Circulation Models. Today, different versions of the 
+OASIS coupler are used by about 35 modelling groups in Europe, Australia, Asia and
+North America on the different computing platforms \citep{valcke8}\footnote{The list of
+coupled models realized with OASIS can be found at https://verc.enes.org/oasis/oasis-dedicated-user-support-1/some-current-users}.
+OASIS sustained development is ensured by a collaboration
+between CERFACS and the Centre National de la Recherche Scientifique
+(CNRS) and its maintainance and user support is presently reinforced
+with additional resources coming from the IS-ENES2 project funded by the EU.
+
+The current OASIS3-MCT is interfaced with MCT, the Model
+Coupling Toolkit\footnote{www.mcs.anl.gov/research/projects/mct/} \citep{mct_larson} \newline \citep{mct_jacob}, developed by the Argonne National Laboratory in the USA. MCT implements fully parallel regridding, as a parallel matrix vector 
+multiplication, and parallel distributed exchanges of the coupling
+fields, based on pre-computed regridding weights and addresses. 
+Its design philosophy, based on flexibility and minimal invasiveness,
+is close to the OASIS approach. 
+MCT has proven parallel performance and is, most notably, the
+underlying coupling software used in National Center for Atmospheric
+Research Community Earth System Model 1 (NCAR CESM1).
+
+OASIS3-MCT is a portable set of Fortran 77, Fortran 90 and C routines. Low-intrusiveness, portability and flexibility are OASIS3-MCT key design concepts. After compilation OASIS3-MCT is a coupling library that needs to be linked to the component models, and which main function is to interpolate and exchange the coupling fields between them to form a coupled system.  OASIS3-MCT supports  coupling of 2D logically-rectangular fields but 3D fields and 1D fields expressed on unstructured grids are also supported using a one dimension degeneration of the structures. Thanks to MCT, all transformations, including regridding, are executed in parallel on the set of source or target component processes and all couplings are now executed in parallel directly between the components via Message Passing Interface
+(MPI). OASIS3-MCT also supports file I/O using netcdf.  
+
+In spite of the significant changes in underlying implementation, usage of OASIS3-MCT in the codes has largely remained unchanged with respect to OASIS3.3.
+To communicate with another model, or to perform I/O actions, a component model needs to include few specific calls to the OASIS3-MCT coupling library, which Application Programmig Interface (API) used in component models is unchanged.  The use 
+statement has been updated and now requires a single ``use\ mod\_prism'' or ``use mod\_oasis'' statement instead of the various use statements required in prior
+OASIS3 versions.  The {\it namcouple} configuration file is also largely unchanged
+relative to OASIS3, although several options are either not used
+or not supported.  There is a new transformation in {\it namcouple}
+i.e. {\tt MAPPING} which allows a user to specify a mapping
+file generated externally.  The changes between OASIS3.3 and OASIS3-MCT are lilsted in appendix \ref{sec_changes}.
+ 
+First tests done with up to
+8000 cores on the Bullx Curie machine at the TGCC are very encouraging
+and it is therefore very likely that OASIS3-MCT will provide an efficient and
+easy-to-use coupling solution for many climate modelling groups in the few years to come. 
+
+%See appendix \ref{sec_changes} for a more detailed list of changes in this %version.
+
+\section{Step-by-step use of OASIS3-MCT}
+
+To use OASIS3-MCT for coupling models (and/or perform I/O
+actions), one has to follow these steps:
+\begin{enumerate}
+\item Obtain OASIS3-MCT source code (see chapter \ref{sec_Obtaining}).
+\item Get familiar with OASIS3-MCT by going through the tutorial steps. The tutorial sources are given in directory {\tt
+  examples/tutorial} and all explanations are provided in the document {\tt tutorial\_oasis3-mct.pdf} therein. 
+
+\item Identify the coupling or I/O fields and adapt the component
+  models to allow their exchange with the OASIS3-MCT coupling library based on MPI1 message passing.
+  The OASIS3-MCT coupling library uses NetCDF and therefore can be used to perform I/O actions
+  from/to disk files.  For more detail on how to interface a model
+  with OASIS3-MCT, see chapter \ref{sec_modelinterfacing}.
+
+\item Define all coupling and I/O parameters and the transformations
+  required to adapt each coupling field from the source model grid to
+  the target model grid; on this basis, prepare OASIS3-MCT configuring file 
+  {\it namcouple} (see chapter \ref{sec_namcouple}). 
+  OASIS3-MCT supports different interpolation algorithms as described in
+  chapter \ref{sec_transformations}.  Regridding files can be computed
+  online using the SCRIP options or offline and read using the MAPPING
+  transformation.
+
+{\bf We strongly recommend to tests off-line the quality of the chosen transformations and regriddings} using the environment available in {\tt
+  examples/test\_interpolation} and explanations provided in the document {\tt test\_interpolation\_oasis3-mct.pdf} therein. 
+
+\item Generate required auxiliary data files (see chapter
+  \ref{sec_auxiliary}).
+\item Compile OASIS3-MCT, the component models and start the coupled
+  experiment. Details on how to compile and run a coupled model with OASIS3-MCT can be found in section \ref{sec_compilationrunning}. 
+
+\end{enumerate}
+
+If you need extra help, do not hesitate to contact us (see contact
+details on the back of the cover page).
+
+\section{OASIS3-MCT sources}
+\label{sec_Obtaining}
+OASIS3-MCT sources are available from CERFACS SVN server. To obtain more detail on downloading
+the sources, please fill in the registration form at
+https://verc.enes.org/oasis/download/oasis-registration-form .
+
+OASIS3-MCT directory structure is the following one:
+
+\begin{verbatim}
+ - oasis3-mct/lib/psmile         OASIS3-MCT coupling library
+                 /scrip          SCRIP interpolation library
+                 /mct            Model Coupling Toolkit Coupling Software
+                  
+ - oasis3-mct/doc                OASIS3-MCT User Guide
+
+ - oasis3-mct/util/make_dir      Utilities to compile OASIS3-MCT
+
+ - oasis3-mct/examples           Environment to run the tutorial and
+                                 test_interpolation toy coupled models. 
+\end{verbatim}
+\newpage
+\section{Licenses and Copyrights}
+ 
+\subsection{OASIS3-MCT license and copyright statement}
+
+Copyright Â© 2013 Centre Europ\'een de Recherche et Formation
+Avanc\'ee en Calcul Scientifique (CERFACS).  
+
+This software and ancillary information called OASIS3-MCT is free
+software.  CERFACS has rights to use, reproduce, and distribute
+OASIS3-MCT. The public may copy, distribute, use, prepare derivative works and
+publicly display OASIS3-MCT under the terms of the Lesser GNU General
+Public License (LGPL) as published by the Free Software Foundation,
+provided that this notice and any statement of authorship are
+reproduced on all copies. If OASIS3-MCT is modified to produce derivative
+works, such modified software should be clearly marked, so as not to
+confuse it with the OASIS3-MCT version available from CERFACS.
+
+The developers of the OASIS3-MCT software are researchers attempting to
+build a modular and user-friendly coupler accessible to the climate
+modelling community. Although we use the tool ourselves and have made
+every effort to ensure its accuracy, we can not make any
+guarantees. We provide the software to you for free. In return,
+you--the user--assume full responsibility for use of the software. The
+OASIS3-MCT software comes without any warranties (implied or expressed) and
+is not guaranteed to work for you or on your computer. Specifically,
+CERFACS and the various individuals involved in development and
+maintenance of the OASIS3-MCT software are not responsible for any damage
+that may result from correct or incorrect use of this software.
+
+\subsection{MCT copyright statement}
+\label{sec_MCT}
+
+                            Modeling Coupling Toolkit (MCT) Software
+
+Copyright Â© 2011, UChicago Argonne, LLC as Operator of Argonne National Laboratory. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+\begin{enumerate}
+\item Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+\item Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+\item The end-user documentation included with the redistribution, if any, must include the following acknowledgment: "This product includes software developed by the UChicago Argonne, LLC, as Operator of Argonne National Laboratory." Alternately, this acknowledgment may appear in the software itself, if and wherever such third-party acknowledgments normally appear.
+
+This software was authored by:
+\begin{itemize}
+\item Argonne National Laboratory Climate Modeling Group, Mathematics and Computer Science Division, Argonne National Laboratory, Argonne IL 60439
+\item Robert Jacob, tel: (630) 252-2983, E-mail: jacob@mcs.anl.gov
+\item Jay Larson, E-mail: larson@mcs.anl.gov
+\item Everest Ong
+\item Ray Loy
+\end{itemize}
+
+\item WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS" WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE OR NON-IN- FRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4) DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL BE CORRECTED. 
+
+\item LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT, INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE, EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE POSSIBILITY OF SUCH LOSS OR DAMAGES.
+
+\end{enumerate}
+
+\subsection{The SCRIP 1.4 license copyright statement}
+\label{sec_SCRIP}
+
+The SCRIP 1.4 copyright statement reads as follows:
+
+``Copyright Â© 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
+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.''
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG1_Obtaining.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG1_Obtaining.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG1_Obtaining.tex	(revision 4775)
@@ -0,0 +1,86 @@
+\newpage
+\chapter{OASIS3 sources, license and Copyright}
+\label{sec_Obtaining}
+%               ----------------------------------
+%
+%
+\section{OASIS3 sources}
+OASIS3 sources, related libraries, and TOYOASIS3
+coupled model sources and data are available from CERFACS SVN server. To obtain more detail on how to download
+the sources, please
+contact us (see contact details on the back of the cover page).
+
+OASIS3 directory structure is the following one:
+
+\begin{verbatim}
+
+ - oasis3/lib/psmile      PRISM System Model Interface Library
+             /scrip       SCRIPR interpolation library
+             /mct         Model Coupling Toolkit Coupling Software
+                  
+ - oasis3/doc             OASIS3 documentation
+ 
+ - oasis3/util/make_dir   Utilities to compile OASIS3 (see section 8.1) 
+
+ - oasis3/examples/tutorial  environment to run the tutorial toymodel
+                              (see section 8.3)
+ 
+\end{verbatim}
+%                              
+% 
+%                  /sxgmem/    GMEM communication library
+%
+%\end{verbatim}
+
+\section{License and Copyright}
+
+\subsection{OASIS3 license and copyright statement}
+
+Copyright Â© 2010 Centre Europeen de Recherche et Formation
+Avancee en Calcul Scientifique (CERFACS).  
+
+This software and ancillary information called OASIS3 is free
+software.  CERFACS has rights to use, reproduce, and distribute
+OASIS3. The public may copy, distribute, use, prepare derivative works and
+publicly display OASIS3 under the terms of the Lesser GNU General
+Public License (LGPL) as published by the Free Software Foundation,
+provided that this notice and any statement of authorship are
+reproduced on all copies. If OASIS3 is modified to produce derivative
+works, such modified software should be clearly marked, so as not to
+confuse it with the OASIS3 version available from CERFACS.
+
+The developers of the OASIS3 software are researchers attempting to
+build a modular and user-friendly coupler accessible to the climate
+modelling community. Although we use the tool ourselves and have made
+every effort to ensure its accuracy, we can not make any
+guarantees. We provide the software to you for free. In return,
+you--the user--assume full responsibility for use of the software. The
+OASIS3 software comes without any warranties (implied or expressed) and
+is not guaranteed to work for you or on your computer. Specifically,
+CERFACS and the various individuals involved in development and
+maintenance of the OASIS3 software are not responsible for any damage
+that may result from correct or incorrect use of this software.
+
+\subsection{The SCRIP 1.4 license copyright statement}
+\label{sec_SCRIP}
+
+The SCRIP 1.4 copyright statement reads as follows:
+
+ ``Copyright Â© 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 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.''
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG2_Model_interfacing.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG2_Model_interfacing.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG2_Model_interfacing.tex	(revision 4775)
@@ -0,0 +1,1146 @@
+\newpage
+\chapter{Interfacing a component model with OASIS3-MCT}
+\label{sec_modelinterfacing}
+
+At run-time, OASIS3-MCT allows exchanging coupling data between two
+components as well as interpolation and transformation of these
+coupling fields. Different communication techniques have been
+historically developed in OASIS. With OASIS3-MCT, communication is
+performed by MCT based on Message Passing Interface 1 (MPI1) protocol.
+
+For a practical example using the OASIS3-MCT library, see the sources
+in {\tt examples/tutorial} and explanations in the {\tt
+  test\_interpolation\_oasis3-mct.pdf} document therein.
+
+To communicate with another component model or to perform I/O actions,
+a component model needs to be interfaced with the OASIS3-MCT library,
+which sources can be found in {\tt oasis3-mct/lib/psmile}
+directory. The OASIS3-MCT library supports:
+
+\begin{itemize}
+\item parallel communication between parallel component models,
+\item coupling a component on a subset of it's processeses only,
+\item automatic sending and receiving actions at appropriate times
+  following user's choice indicated in the {\it namcouple},
+\item time integration or accumulation of the coupling fields,
+\item some transformations such as mapping (interpolation) between
+  grids,
+\item I/O actions from/to files.
+\end{itemize}
+
+To adapt a component model to OASIS3-MCT, specific calls of the
+following classes have to be implemented in the code:
+
+\begin{enumerate}
+\item Initialisation (section \ref{subsubsec_Initialisation})
+\item Grid data file definition (section \ref{subsubsec_griddef})
+\item Partition definition (section \ref{subsubsec_Partition})
+\item Coupling-I/O field declaration (section
+  \ref{subsubsec_Declaration})
+\item End of definition phase (section
+  \ref{subsubsec_Endofdefinition})
+\item Coupling-I/O field sending and receiving (section
+  \ref{subsubsec_sendingreceiving})
+\item Termination (section \ref{subsubsec_Termination})
+\item Optional auxiliary routines (section
+  \ref{subsubsec_auxroutines})
+\end{enumerate}
+
+Finally, in section \ref{subsubsec_Algoritms}, different coupling
+algorithms are illustrated and details on how to reproduce them with
+OASIS3-MCT are provided. More information on the {\tt LAG} and {\tt
+  SEQ} indices are also given in that section.
+
+\section{Use of OASIS3-MCT library}
+\label{subsubsec_Use}
+% {Use}
+
+To use OASIS3-MCT library, a user needs to add in his code:
+
+\begin{itemize}
+
+\item {\tt USE mod\_oasis}
+
+  ** OR **
+
+\item {\tt USE mod\_prism}
+ 
+\end{itemize}
+
+Both use statements are valid and use of just one or the other is
+recommended in a particular component model. A single use statement
+now provides all the methods that required multiple use statements in
+previous OASIS3 versions.  The methods, datatypes, and capabilities
+are identical for both the {\tt mod\_prism} or {\tt mod\_oasis}
+interfaces.  The only difference is the name of the interface. The
+interface in module {\tt mod\_prism} is provided for backwards
+compatability with prior versions of OASIS3. Use of module {\tt
+  mod\_oasis} is now recommended provides access to a set of updated
+routine names that will continue to evolve in the future, always
+ensuring backward compatibility.  In the following sections, both the
+{\tt mod\_prism} and {\tt mod\_oasis} interface names are defined and
+a single description of the interface arguments is provided.
+
+\section{Initialisation}
+\label{subsubsec_Initialisation}
+% {Initialisation}
+
+\subsection{Coupling initialisation}
+
+\begin{itemize}
+
+\item {\tt CALL oasis\_init\_comp (compid, model\_name, ierror)}
+\item {\tt CALL prism\_init\_comp\_proto (compid, model\_name,
+    ierror)}
+
+  \begin{itemize}
+  \item {\tt compid [INTEGER; OUT]}: component model ID
+  \item {\tt model\_name [CHARACTER*6; IN]}: component model name (as
+    in {\em namcouple} under {\tt \$NBMODEL})
+  \item {\tt ierror [INTEGER; OUT]}: returned error code.
+  \end{itemize}
+ 
+  This routine must called by all component processes to initialise
+  the coupling.\footnote{The model may call MPI\_Init explicitly, but
+    if so, has to call it before calling {\tt oasis\_init\_comp}; in
+    this case, the model also has to call MPI\_Finalize explicitly,
+    but only after calling {\tt oasis\_terminate}.}
+\end{itemize}
+
+\subsection{Communicator for internal parallelisation}
+\label{subsec_MPI1}
+
+\begin{itemize}
+\item {\tt CALL oasis\_get\_localcomm (local\_comm, ierror )}
+\item {\tt CALL prism\_get\_localcomm\_proto (local\_comm, ierror )}
+
+  \begin{itemize}
+  \item {\tt local\_comm [INTEGER; OUT]}: value of local communicator
+  \item {\tt ierror [INTEGER; OUT]}: returned error code.
+  \end{itemize}
+
+  If needed, this routine may be called by the component processes to
+  get the value of a local communicator to be used by the component
+  for its internal parallelisation.
+
+  This may be needed as all component models started in a pseudo-MPMD
+  mode with MPI1 share automatically the same MPI\_COMM\_WORLD
+  communicator.  Another communicator has to be used for the internal
+  parallelisation of each component. OASIS3-MCT creates this local
+  communicator based on the name given to {\tt oasis\_init\_comp}
+  routine; its value is returned as the first argument of the routine,
+  {\tt local\_comm}.
+
+  % With CLIM-MPI2, OASIS3 executable spawns the component model
+  % executables at the beginning of the run; the components keep their
+  % internal parallelisation context unchanged with respect to their
+  % standalone mode. In this case, calling the
+  % prism\_get\_localcomm\_proto routine is useless but if called, the
+  % communicator MPI\_COMM\_WORLD will be returned as local
+  % communicator.
+\end{itemize}
+
+\subsection{Coupling through a subset of the component model
+  processes}
+\label{subsec_subset}
+
+If only a subset of the component processes participate in the
+coupling, a communicator gathering only these processes must be
+defined, with {\tt oasis/prism\_create\_couplcomm} or \newline {\tt
+  oasis/prism\_set\_couplcomm}. These routines should be called after
+the {\tt oasis\_init\_comp} but before the grid, partition, or
+coupling field declaration.
+
+If such communicator does not exist in the code, the component
+processes have to create it with:
+
+\begin{itemize}
+\item {\tt CALL oasis\_create\_couplcomm(icpl, local\_comm,
+    coupl\_comm, kinfo)}
+\item {\tt CALL prism\_create\_couplcomm(icpl, local\_comm,
+    coupl\_comm, kinfo)}
+  \begin{itemize}
+  \item {\tt icpl [INTEGER; IN]}: coupling process flag
+  \item {\tt local\_comm [INTEGER; IN]}: MPI communicator with all
+    processes of the component
+  \item {\tt coupl\_comm [INTEGER; OUT]}: returned MPI communicator
+    gathering only component processes participating in the coupling
+  \item {\tt kinfo [INTEGER; OUT; OPTIONAL]}: returned error code
+  \end{itemize}
+
+  This routine creates a coupling communicator for a subset of
+  processes. It must be called by all component processes with {\tt
+    icpl=1} for processes participating in the coupling and with {\tt
+    icpl =} {\tt MPI\_UNDEFINED} for the others. Argument {\tt
+    local\_comm} is the MPI communicator associated with all processes
+  of the component. The new coupling communicator is returned in {\tt
+    coupl\_comm}.
+\end{itemize}
+
+If this communicator already exist in the code, the component should
+simply provide it to OASIS3-MCT with:
+
+\begin{itemize}
+\item {\tt CALL oasis\_set\_couplcomm(coupl\_comm, kinfo)}
+\item {\tt CALL prism\_set\_couplcomm(coupl\_comm, kinfo)}
+  \begin{itemize}
+  \item {\tt coupl\_comm [INTEGER; IN]}: MPI communicator gathering
+    only component processes participating in the coupling
+  \item {\tt kinfo [INTEGER; OUT; OPTIONAL]}: returned error code
+  \end{itemize}
+
+  This routine allows to provide a local coupling communicator to
+  OASIS3-MCT, given that it already exists in the code. The value of
+  {\tt coupl\_comm} must be the value of this local coupling
+  communicator for the processes participating to the coupling and it
+  must be {\tt MPI\_COMM\_NULL} for processes not involved in the
+  coupling.
+\end{itemize}
+
+
+All OASIS3-MCT interface routines, besides the grid definition (see
+section \ref{subsubsec_griddef}) and the {\tt oasis\_put} and {\tt
+  oasis\_get} per se (see section \ref{subsubsec_sendingreceiving}),
+are collective and must be called by all processes of an executable.
+% \footnote{In fact, the {\tt oasis\_def\_var/prism\_def\_var\_proto}
+%   must be %called by at least the root process of the coupler
+%   communicator but can be called by all processes.}.
+In particular, the {\tt oasis\_def\_partition} (see section
+\ref{subsubsec_Partition}) must be called by all processes, but with
+{\tt ig\_paral(:)=0} for the processes not involved in the coupling;
+also, these processes must call the same number of {\tt
+  oasis\_def\_var} than the ones participating to the coupling, even
+if the associated field symbolic names and partition ID (see {\tt
+  name} and {\tt il\_part\_id} arguments in section
+\ref{subsubsec_Declaration}) can then be anything.
+
+
+\subsection{Separate executable not coupling at all}
+\label{subsec_nocpl}
+
+For a separate executable part of a coupled system managed by
+OASIS3-MCT but for which all processes are not involved in the
+coupling (such as a separate I/O server), the only calls that should
+be made are :
+
+\begin{verbatim}
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  CALL oasis_get_localcomm ( localComm, ierror )   ! optional
+  CALL oasis_enddef ( ... )
+  CALL oasis_terminate ( ... )
+\end{verbatim}
+
+\section{Grid data file definition}
+\label{subsubsec_griddef}
+
+With OASIS3-MCT, the grid data files {\em grids.nc, masks.nc} and {\em
+  areas.nc} are required only for certain operations (see also section
+\ref{subsec_griddata}), i.e.  {\em grids.nc}, and {\em masks.nc} for
+{\tt SCRIPR} (see section \ref{subsec_interp}) and {\em masks.nc} and
+{\em areas.nc} for {\tt CONSERV} (see section
+\ref{subsec_cooking}). These grid data files can be created by the
+user before the run or can be written directly at run time by the {\bf
+  master process of each component model} with the following routines.
+These routines can be used by the component models to {\bf add grid}
+fields to the grid files but {\bf not to overwrite} them . These
+routines have to be called just after {\tt oasis\_init\_comp}.
+
+\begin{itemize}
+
+\item {\tt CALL oasis\_start\_grids\_writing (flag)} or
+\item {\tt CALL prism\_start\_grids\_writing (flag)}
+  \begin{itemize}
+  \item {\tt flag [INTEGER; OUT]}: not used
+  \end{itemize}
+  Obsolete in OASIS3-MCT; exists however for upward compatibility.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_write\_grid (cgrid, nx, ny, lon, lat)} or
+\item {\tt CALL prism\_write\_grid (cgrid, nx, ny, lon, lat)}
+        
+  \begin{itemize}
+  \item {\tt cgrid [CHARACTER*4; IN]}: grid name prefix (see
+    \ref{subsec_namcouplesecond})
+  \item {\tt nx [INTEGER; IN]} : first grid dimension (x)
+  \item {\tt ny [INTEGER; IN]} : second grid dimension (y)
+  \item {\tt lon [REAL, DIMENSION(nx,ny); IN)} : single or double real array of longitudes
+    (degrees East)
+  \item {\tt lat [REAL, DIMENSION(nx,ny); IN)} : single or double real array of latitudes
+    (degrees North)
+  \end{itemize}
+
+  Writes the model grid longitudes and latitudes. Longitudes must be
+  given in degrees East in the interval -360.0 to 720.0. Latitudes
+  must be given in degrees North in the interval -90.0 to 90.0. Note
+  that if some grid points overlap, it is recommended to define those
+  points with the same number (e.g. 90.0 for both, not 450.0 for one
+  and 90.0 for the other) to ensure automatic detection of overlap by
+  OASIS3-MCT (which is essential to have a correct conservative
+  remapping \texttt{SCRIPR/CONSERV}, see section \ref{subsec_interp}).
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_write\_corner (cgrid, nx, ny, nc, clon, clat)}
+  or
+\item {\tt CALL prism\_write\_corner (cgrid, nx, ny, nc, clon, clat)}
+
+  \begin{itemize}
+  \item {\tt cgrid [CHARACTER*4; IN]}: grid name prefix
+  \item {\tt nx [INTEGER; IN]} : first grid dimension (x)
+  \item {\tt ny [INTEGER; IN]} : second grid dimension (y)
+  \item {\tt nc [INTEGER; IN]} : number of corners per grid cell
+    (always 4 in the version)
+  \item {\tt lon [REAL, DIMENSION (nx,ny,nc);IN]} : single or double real array of corner
+    longitudes (in degrees\_East)
+  \item {\tt lat [REAL, DIMENSION (nx,ny,nc);IN]} : single or double real array of corner
+    latitudes (in degrees\_North)
+  \end{itemize}
+
+  Writes the grid cell corner longitudes and latitudes
+  (counterclockwise sense). Longitudes must be given in degrees East
+  in the interval -360.0 to 720.0. Latitudes must be given in degrees
+  North in the interval -90.0 to 90.0. Note also that cells larger
+  than 180.0 degrees in longitude are not supported. Writing of
+  corners is optional as corner information is needed only for {\tt
+    SCRIPR/CONSERV} (see section \ref{subsec_interp}). If called,
+  needs to be called after {\tt oasis/prism\_write\_grid}.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_write\_mask (cgrid, nx, ny, mask)} or
+\item {\tt CALL prism\_write\_mask (cgrid, nx, ny, mask)}
+
+  \begin{itemize}
+  \item {\tt cgrid [CHARACTER*4; IN]}: grid name prefix
+  \item {\tt nx [INTEGER; IN]} : first grid dimension (x)
+  \item {\tt ny [INTEGER; IN]} : second grid dimension (y)
+  \item {\tt mask [INTEGER, DIMENSION(nx,ny) ;IN]} : mask array (be
+    careful about the OASIS historical convention (!): 0 = not masked,
+    1 = masked)
+  \end{itemize}
+  Writes the model grid mask.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_write\_area (cgrid, nx, ny, area)} or
+\item {\tt CALL prism\_write\_area (cgrid, nx, ny, area)}
+
+  \begin{itemize}
+  \item {\tt cgrid [CHARACTER*4; IN]}: grid name prefix
+  \item {\tt nx [INTEGER; IN]} : first grid dimension (x)
+  \item {\tt ny [INTEGER; IN]} : second grid dimension (y)
+  \item {\tt area [REAL, DIMENSION(nx,ny); IN]} : single or double real array of grid cell
+    areas
+  \end{itemize}
+  Writes of the model grid cell areas. Needed only for {\tt CONSERV}
+  operation (see section \ref{subsec_cooking}).
+
+  \vspace{0.2cm}
+\item {\tt CALL prism\_terminate\_grids\_writing()}
+\item {\tt CALL oasis\_terminate\_grids\_writing()}
+
+  Terminates grids writing (required if some of the above grid writing
+  routines are called).
+
+\end{itemize}
+
+The creation of the different files is effective in the routine
+oasis\_enddef.
+
+\section{Partition definition}
+\label{subsubsec_Partition}
+
+
+The coupling fields sent or received by a component model are usually
+scattered among the different component processes. With OASIS3-MCT,
+all processes exchanging coupling data have to define their local
+partition in the global index space.
+
+If only a subset of the processes actually exchange coupling data, the
+processes not implied in the coupling have to call this routine to
+describe a null partition (i.e. with {\tt ig\_paral(:)=0}).
+
+If the sum of the partitions defined over all the processes do not
+cover the global grid, the total dimension of the grid (total number
+of points) must be given as an optional argument (see {\tt isize}
+below).
+
+\begin{itemize}
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_def\_partition (il\_part\_id, ig\_paral,
+    ierror, isize)} or
+\item {\tt CALL prism\_def\_partition\_proto (il\_part\_id, ig\_paral,
+    ierror, isize)}
+
+  \begin{itemize}
+  \item {\tt il\_part\_id [INTEGER; OUT]}: partition ID
+  \item {\tt ig\_paral [INTEGER, DIMENSION(:), IN]}: vector of
+    integers describing the local partition in the global index space;
+    has a different expression depending on the type of the partition;
+    in OASIS3-MCT, 5 types of partition are supported: Serial (no
+    partition), Apple, Box, Orange, and Points (see below).
+  \item {\tt ierror [INTEGER; OUT]}: returned error code.
+  \item {\tt isize [INTEGER, OPTIONAL, IN]}: Optional argument needed
+    if the coupling data is exchanged for only a subdomain of the
+    global grid; in this case, isize must give the total dimension of
+    the grid (total number of points).
+  \end{itemize}
+\end{itemize}
+
+\subsection{Serial (no partition)}
+
+This is the choice for a monoprocess model. In this case, we have {\tt
+  ig\_paral(1:3)}:
+\begin{itemize}
+\item {\tt ig\_paral(1)} = 0 (indicates a Serial ``partition'')
+\item {\tt ig\_paral(2)} = 0
+\item {\tt ig\_paral(3)} = the total grid size.
+\end{itemize}
+
+\subsection{Apple partition}
+
+Each partition is a segment of the global domain, described by its
+global offset and its local size. In this case, we have {\tt
+  ig\_paral(1:3)}:
+\begin{itemize}
+\item {\tt ig\_paral(1)} = 1 (indicates an Apple partition)
+\item {\tt ig\_paral(2)} = the segment global offset
+\item {\tt ig\_paral(3)} = the segment local size
+\end{itemize}
+
+Figure \ref{apple_partition} illustrates an Apple partition over 3
+processes.
+\begin{figure}
+  \includegraphics[scale=.6]{figures/apple_new}
+  \caption{Apple partition. It is assumed here that the index start at
+    0 in the upper left corner.}
+  \label{apple_partition}
+\end{figure}
+
+
+\subsection{Box partition}
+
+Each partition is a rectangular region of the global domain, described
+by the global offset of its upper left corner, and its local extents
+in the X and Y dimensions. The global extent in the X dimension must
+also be given. In this case, we have {\tt ig\_paral(1:5)}:
+\begin{itemize}
+\item {\tt ig\_paral(1)} = 2 (indicates a Box partition)
+\item {\tt ig\_paral(2)} = the upper left corner global offset
+\item {\tt ig\_paral(3)} = the local extent in x
+\item {\tt ig\_paral(4)} = the local extent in y
+  % \footnote{The maximum value of the local extent in y is presently
+  %   338; it can be increased by modifying the value of {\tt
+  %     Clim\_MaxSegments} in {\tt oasis3/lib/clim/src/mod\_clim.F90}
+  %   and in {\tt oasis3/lib/psmile/src/mod\_prism\_proto.F90} and by
+  %   recompiling OASIS3 and the PSMILe library.}
+\item {\tt ig\_paral(5)} = the global extent in x.
+\end{itemize}
+
+Figure \ref{box_partition} illustrates a Box partition over 3
+processes.
+ 
+\begin{figure}
+  \includegraphics[scale=.6]{figures/box_new}
+  \caption{Box partition. It is assumed here that the index start at 0
+    in the upper left corner.}
+  \label{box_partition}
+\end{figure}
+  
+\subsection{Orange partition}
+
+Each partition is an ensemble of segments of the global domain. Each
+segment is described by its global offset and its local extent.  In
+this case, we have {\tt ig\_paral(1:N)} where {\tt N = 2 + 2*number of
+  segments}
+% \footnote{As for the Box partition, the maximum number of segments
+%   is presently 338; it can be increased by modifying the value of
+%   {\tt Clim\_MaxSegments}}.
+
+\begin{itemize}
+\item {\tt ig\_paral(1)} = 3 (indicates a Orange partition)
+\item {\tt ig\_paral(2)} = the total number of segments for the
+  partition (limited to 200 presently, see note for ig\_paral(4) for
+  Box partition above)
+\item {\tt ig\_paral(3)} = the first segment global offset
+\item {\tt ig\_paral(4)} = the first segment local extent
+\item {\tt ig\_paral(5)} = the second segment global offset
+\item {\tt ig\_paral(6)} = the second segment local extent
+\item ...
+\item {\tt ig\_paral(N-1)} = the last segment global offset
+\item {\tt ig\_paral(N)} = the last segment local extent
+\end{itemize}
+
+Figure \ref{orange_partition} illustrates an Orange partition with 3
+segments for one process. The other process partitions are not
+illustrated.
+
+\begin{figure}
+  \includegraphics[scale=.6]{figures/orange_new}
+  \caption{Orange partition for one process. It is assumed here that
+    the index start at 0 in the upper left corner.}
+  \label{orange_partition}
+\end{figure}
+
+\subsection{Points partition}
+
+This partition is a list of global indices associated with each
+processor.  The index naming
+is arbitrary but must be consistent between all processors involved
+in the partition description.  In
+this case, we have {\tt ig\_paral(1:N)} where {\tt N = 2 + number of
+  points}
+% \footnote{As for the Box partition, the maximum number of segments
+%   is presently 338; it can be increased by modifying the value of
+%   {\tt Clim\_MaxSegments}}.
+
+\begin{itemize}
+\item {\tt ig\_paral(1)} = 4 (indicates a Points partition)
+\item {\tt ig\_paral(2)} = currently not used
+\item {\tt ig\_paral(3)} = the first global index
+\item {\tt ig\_paral(4)} = the second global index
+\item ...
+\item {\tt ig\_paral(N)} = the last global index
+\end{itemize}
+
+% {Partition definition}
+
+\section{Coupling field declaration}
+\label{subsubsec_Declaration}
+
+All component processes declares the fields sent or received by the
+component during the simulation.
+ 
+If some processes of a model are not involved in the coupling, they
+still have to call the same number of {\tt oasis\_def\_var} than the
+ones participating to the coupling, even if the associated field
+symbolic names and partition ID (see {\tt name} and {\tt il\_part\_id}
+below) can then be anything.
+
+\begin{itemize}
+
+\item {\tt CALL oasis\_def\_var (var\_id, name, il\_part\_id,
+    var\_nodims, kinout, \newline var\_actual\_shape, var\_type,
+    ierror)} or
+
+\item {\tt CALL prism\_def\_var\_proto(var\_id, name, il\_part\_id,
+    var\_nodims, kinout, var\_actual\_shape, var\_type, ierror)}
+
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; OUT]}: coupling field ID\footnote{If
+      the field does not appear in the {\it namcouple}, the returned
+      field ID will be equal to -1 and corresponding {\it oasis\_put}
+      and {\it oasis\_get} cannot be called in the code}.
+  \item {\tt name [CHARACTER*128; IN]}: field symbolic name (as in the
+    {\it namcouple})
+  \item {\tt il\_part\_id [INTEGER; IN]}: partition ID (see section
+    \ref{subsubsec_Partition})
+  \item {\tt var\_nodims [INTEGER, DIMENSION(2); IN]}: var\_nodims(1)
+    is the rank of field array (1 or 2); var\_nodims(2) is the number
+    of bundles (always 1 in the current OASIS3-MCT version).
+  \item {\tt kinout [INTEGER; IN]}: {\tt OASIS\_In} or {\tt PRISM\_In}
+    (i.e. = 15) for fields received by the model; {\tt OASIS\_Out},
+    {\tt PRISM\_Out} (i.e. = 14) for fields sent by the model
+    \footnote{Parameters OASIS\_In, PRISM\_In, OASIS\_Out, PRISM\_Out
+      are defined in
+      oasis3-mct/lib/psmile/src/mod\_oasis\_parameters.F90}.
+  \item {\tt var\_actual\_shape [INTEGER, DIMENSION(2*var\_nodims(1));
+      IN]}: vector of integers giving the minimum and maximum index
+    for each dimension of the coupling field array; for the current
+    OASIS3-MCT version, the minimum index has to be 1 and the maximum
+    index has to be the extent of the dimension.
+  \item {\tt var\_type [INTEGER; IN]}: type of coupling field array;
+    put {\tt OASIS\_Real} or {\tt PRISM\_Real} (i.e. = 4) for single
+    or double precision real arrays.  All coupling data is treated as
+    double precision in the coupling layer, but conversion to or from
+    single precision data is supported in the interface.
+  \item {\tt ierror [INTEGER; OUT]}: returned error code.
+  \end{itemize}
+\end{itemize}
+% {coupling field declaration}
+
+\section{End of definition phase}
+\label{subsubsec_Endofdefinition}
+All component processes close the definition phase.
+\begin{itemize}
+\item {\tt CALL oasis\_enddef (ierror)}
+\item {\tt CALL prism\_enddef\_proto(ierror)}
+  \begin{itemize}
+  \item ierror [INTEGER; OUT]: returned error code.
+  \end{itemize}
+\end{itemize}
+
+% {End of definition phase}
+
+\section{Sending ``put'' and receiving ``get'' actions}
+\label{subsubsec_sendingreceiving}
+
+\subsection{Sending a coupling (or I/O) field}
+\label{prismput}
+
+In the model time step loop, each process sends its part of the
+coupling (or I/O) field.
+
+\begin{itemize}
+\item {\tt CALL oasis\_put (var\_id, date, fld1, info, fld2, fld3,
+    fld4, fld5)}
+\item {\tt CALL prism\_put\_proto(var\_id, date, fld1, info, fld2,
+    fld3, fld4, fld5)}
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; IN]}: field ID (from corresponding {\tt
+      oasis\_def\_var}, see section \ref{subsubsec_Declaration})
+  \item {\tt date [INTEGER; IN]}: number of seconds (or any other time
+    units as long as the same are used in all models and in the {\it
+      namcouple}) at the time of the call (by convention at the
+    beginning of the timestep)
+  \item {\tt fld1 [REAL, IN]}: coupling (or I/O) field array; can be
+    1D or 2D
+  \item {\tt info [INTEGER; OUT]}: returned info code:
+    \begin{itemize}
+    \item OASIS\_Sent(=4) if the field was sent to another model
+    \item OASIS\_LocTrans (=5) if the field was only used in a time
+      transformation (not sent, not output)
+    \item OASIS\_ToRest (=6) if the field was written to a restart
+      file only
+    \item OASIS\_Output (=7) if the field was written to an output
+      file only
+    \item OASIS\_SentOut (=8) if the field was both written to an
+      output file and sent to another model (directly or via OASIS3
+      main process)
+    \item OASIS\_ToRestOut (=9) if the field was written both to a
+      restart file and to an output file.
+    \item OASIS\_Waitforallingroup (=14) if the field was not sent because it is in a group.
+    It will be sent only when the oasis\_put of the last field in the group will be called.
+    \item OASIS\_Ok (=0) otherwise and no error occurred.
+    \end{itemize}
+  \item {\tt fld2 [REAL, IN, OPTIONAL]}: optional $2^{nd}$ coupling
+    field array; can be 1D or 2D
+  \item {\tt fld3 [REAL, IN, OPTIONAL]}: optional $3^{rd}$ coupling
+    field array; can be 1D or 2D
+  \item {\tt fld4 [REAL, IN, OPTIONAL]}: optional $4^{th}$ coupling
+    field array; can be 1D or 2D
+  \item {\tt fld5 [REAL, IN, OPTIONAL]}: optional $5^{th}$ coupling
+    field array; can be 1D or 2D
+  \end{itemize}
+\end{itemize}
+
+To ensure a proper use of the {\tt oasis\_put}, one has to take care
+of the following aspects:
+
+\begin{itemize}
+
+\item A $2^{nd}$, $3^{rd}$, $4^{th}$ and $5^{th}$ source field can be
+  passed as optional arguments. If so, the $2^{nd}$, $3^{rd}$,
+  $4^{th}$ and $5^{th}$ set of weights present in the remapping file
+  will be applied, respectively (see section \ref{subsec_mapdata} for
+  the weight file format). This will be used for example for the {\tt
+    SCRIPR/BICUBIC} remapping for which a $1^{st}$, $2^{nd}$,
+  $3^{rd}$, $4^{th}$ set of weights should be respectively applied to
+  the field value, its gradient in the first dimension, its gradient
+  in the second dimension, and its cross-gradient. With
+  OASIS3-MCT\_2.0 and following versions, bicubic and higher order
+  remapping are therefore supported given that the higher order fields
+  are provided at each time step as {\tt oasis\_put} arguments. Note
+  that if {\tt fld3} is passed, {\tt fld2} must also be passed; if
+  {\tt fld4} is passed, {\tt fld3} and {\tt fld2} must also be passed;
+  and if {\tt fld5} is passed, {\tt fld4}, {\tt fld3} and {\tt fld2}
+  must also be passed. However, having a $2^{nd}$, $3^{rd}$, $4^{th}$
+  and $5^{th}$ set of weights in the remapping file but not passing a
+  $2^{nd}$, $3^{rd}$, $4^{th}$ and $5^{th}$ source field as argument
+  will not lead to an error; the appropriate set of weights will
+  simply be applied to the fields provided as arguments.
+\item Trying to send with {\tt oasis\_put} a field declared with a
+  {\tt oasis\_def\_var} but not defined in the configuration file {\it
+    namcouple} will lead to an abort. In this case, the field ID
+  returned by the {\tt oasis\_def\_var} is equal to -1 and the
+  corresponding {\tt oasis\_put} should not be called.
+\item This routine may be called by the model at each timestep. The
+  convention for the {\tt date} argument is to indicate the time at
+  the beginning of the timestep. The sending is actually performed
+  only if the time obtained by adding the field lag ({\tt LAG} in the
+  {\em namcouple}) to the {\tt date} corresponds to a time at which it
+  should be activated, given the coupling or I/O period indicated by
+  the user in the {\it namcouple} (see section \ref{sec_namcouple}).
+\item If the convention for {\tt date} is followed, the first coupling
+  of a run should occur at time=0 and the final coupling should occur
+  at time = runtime - cpl\_period, where runtime is the total time of
+  the run and cpl\_period is the coupling period.
+\item The total run time should match an integer number of coupling
+  periods.
+\item If a coupling field has a positive lag, the coupling field that
+  matches the {\tt oasis\_get} at time=0 will come from a coupling
+  restart file written by the last active {\tt oasis\_put} of the
+  previous run (see section \ref{subsubsec_Algoritms}). For a coupling
+  field with a positive lag, the coupling restart file (see section
+  \ref{subsec_restartdata}) is automatically overwritten by the {\tt
+    oasis\_put} when the time (i.e. {\tt date+LAG}) equals to the
+  total runtime.
+  % \item A field will not be sent at all if its coupling (or I/O)
+  %   period indicated in the {\it namcouple} is greater than the
+  %   total run time.
+\item If a local time transformation is indicated for the field by the
+  user in the {\it namcouple} (INSTANT, AVERAGE, ACCUMUL, T\_MIN or
+  T\_MAX, see section \ref{sec_transformations}), it is automatically
+  performed and the resulting field is finally sent at the coupling or
+  I/O frequency.  For non-instant transformations, partially
+  transformed fields will be written to the restart file at the end of
+  the run for use on the next model startup.
+\item A coupling field sent by a source component model can be
+  associated with more than one target field and model, if specified
+  as so with different entries in the {\it namcouple} configuration
+  file. In that case, the source model needs to send the field only
+  once and the corresponding data will arrive at multiple targets as
+  specified in the {\it namcouple}. Different coupling frequencies and
+  transformations are allowed for different coupling exchanges of the
+  same field. If coupling restart files are required (either if a {\tt
+    LAG} or if a {\tt LOCTRANS} transformation is specified), it is
+  mandatory to specify different files for the different fields.
+
+\end{itemize}
+
+\subsection{Receiving a coupling (or I/O) field}
+
+In the model time stepping loop, each process receives its part of the
+coupling field.
+
+\begin{itemize}
+ 
+\item {\tt CALL oasis\_get (var\_id, date, fld, info)}
+\item {\tt CALL prism\_get\_proto(var\_id, date, fld, info)}
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; IN]}: field ID (from the corresponding
+    {\tt oasis\_def\_var})
+  \item {\tt date [INTEGER; IN]}: number of seconds (or any other time
+    units as long as the same are used in all models and in the {\it
+      namcouple}) at the time of the call (by convention at the
+    beginning of the timestep)
+  \item {\tt fld [REAL, OUT]}: I/O or coupling field array
+  \item {\tt info [INTEGER; OUT]}: returned info code:
+    \begin{itemize}
+    \item OASIS\_Recvd(=3) if the field was received from another
+      model
+    \item OASIS\_FromRest (=10) if the field was read from a restart
+      file only
+    \item OASIS\_Input (=11) if the field was read from an input file
+      only
+    \item OASIS\_RecvOut (=12) if the field was both received from
+      another model and written to an output file
+    \item OASIS\_FromRestOut (=13) if the field was both read from a
+      restart file and written to an output file
+    \item OASIS\_Waitforallingroup (=14) if the field was not sent because it is in a group.
+    It will be sent only when the oasis\_put of the last field in the group will be called.
+    \item OASIS\_Ok (=0) otherwise and no error occurred.
+    \end{itemize}
+  \end{itemize}
+\end{itemize}
+
+This routine may be called by the model at each timestep. The {\tt
+  date} argument is automatically analysed and the receiving action is
+actually performed only if {\tt date} corresponds to a time for which
+it should be activated, given the period indicated by the user in the
+{\it namcouple}. An exchange at the beginning of the run at time=0 is
+expected.
+
+Trying to receive with {\tt oasis\_get} a field declared with a {\tt
+  oasis\_def\_var} but not defined in the configuration file {\it
+  namcouple} will lead to an abort. In this case, the field ID
+returned by the {\tt oasis\_def\_var} is equal to -1 and the
+corresponding {\tt oasis\_get} should not be called.
+
+\section{Termination}
+\label{subsubsec_Termination}
+
+\begin{itemize}
+
+\item {\tt CALL oasis\_terminate (ierror)}
+\item {\tt CALL prism\_terminate\_proto(ierror)}
+  \begin{itemize}
+  \item {\tt ierror [INTEGER; OUT]}: returned error code.
+  \end{itemize}
+  All processes of the component model must terminate the coupling by
+  calling this routine\footnote{If the process called {\tt MPI\_Init}
+    (before calling {\tt oasis\_init\_comp} or {\tt
+      prism\_init\_comp\_proto}), it must also call {\tt
+      MPI\_Finalize} explicitly, but only after calling {\tt
+      oasis\_terminate\_proto} or {\tt prism\_terminate\_proto}.}
+  (normal termination).
+
+\end{itemize}
+
+% {Termination}
+
+\section{Auxiliary routines}
+\label{subsubsec_auxroutines}
+
+Not all auxiliary routines that were in OASIS3.3 are currently
+available.
+
+\begin{itemize}
+\item {\tt CALL oasis\_abort (compid, routine\_name, abort\_message)}
+\item {\tt CALL prism\_abort\_proto(compid, routine\_name,
+    abort\_message)}
+  \begin{itemize}
+  \item {\tt compid [INTEGER; IN]}: component model ID (from {\tt
+      oasis\_init\_comp} or \newline {\tt prism\_init\_comp\_proto})
+  \item {\tt routine\_name[CHARACTER*; IN]}: name of calling routine
+  \item {\tt abort\_message[CHARACTER*; IN]}: message to be written
+    out.
+  \end{itemize}
+
+  If a process needs to abort voluntarily, it should do so by calling
+  {\tt oasis\_abort}. This will ensure a proper termination of all
+  processes in the coupled model communicator. This routine writes the
+  name of the calling model, the name of the calling routine, and the
+  message to the process debug file (see {\tt \$NLOGPRT} in section
+  \ref{subsec_namcouplefirst}).  This routine cannot be called before
+  {\tt oasis\_init\_comp}.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_get\_debug(debug\_value)}
+\item {\tt CALL prism\_get\_debug(debug\_value)}
+  \begin{itemize}
+  \item {\tt debug\_value [INTEGER; OUT]}: debug value
+  \end{itemize}
+
+  This routine may be called at any time to retrieve the current
+  OASIS3-MCT internal debug level (see {\tt \$NLOGPRT} in section
+  \ref{subsec_namcouplefirst}).  This is useful if the user wants to
+  return the original debug value after changing it.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_set\_debug(debug\_value)}
+\item {\tt CALL prism\_set\_debug(debug\_value)}
+  \begin{itemize}
+  \item {\tt debug\_value [INTEGER; IN]}: debug value
+  \end{itemize}
+
+  This routine may be called at any time to change the debug level in
+  OASIS3-MCT.  This method allows users to vary the debug level at
+  different points in the model integration.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_get\_intercomm(new\_comm, cdnam, kinfo)}
+\item {\tt CALL prism\_get\_intercomm(new\_comm, cdnam, kinfo)}
+  \begin{itemize}
+  \item {\tt new\_comm [INTEGER; OUT]}: mpi intercomm communicator
+  \item {\tt cdnam [CHARACTER*; IN]}: other model name
+  \item {\tt kinfo [INTEGER; OUT; OPTIONAL]}: returned error code
+  \end{itemize}
+
+  This routine sets up an MPI intercomm communicator between the root
+  processors of two components, the local component and the component
+  associated with {\tt cdnam}.  This call is collective across the
+  tasks of the two components but other components are not involved.
+
+  \vspace{0.2cm}
+\item {\tt CALL oasis\_get\_intracomm(new\_comm, cdnam, kinfo)}
+\item {\tt CALL prism\_get\_intracomm(new\_comm, cdnam, kinfo)}
+  \begin{itemize}
+  \item {\tt new\_comm [INTEGER; OUT]}: mpi intracomm communicator
+  \item {\tt cdnam [CHARACTER*; IN]}: other model name
+  \item {\tt kinfo [INTEGER; OUT; OPTIONAL]}: returned error code
+  \end{itemize}
+
+  This routine sets up an MPI intracomm communicator between the root
+  processors of two components, the local component and the component
+  associated with cdnam.  This call is collective across the tasks of
+  the two components but other components are not involved.
+
+\item {\tt CALL oasis\_put\_inquire(var\_id, date, kinfo)}
+\item {\tt CALL prism\_put\_inquire\_proto(var\_id, date, kinfo)}
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; IN]}: field ID (from
+  corresponding oasis\_def\_var)
+  \item {\tt date [INTEGER; IN]}: number of seconds in the run at the
+  time of the call
+  \item {\tt kinfo [INTEGER; OUT]}: returned info code
+    \begin{itemize}
+    \item OASIS\_Sent(=4) if the field was sent to another model
+    \item OASIS\_LocTrans (=5) if the field was only used in a time
+      transformation (not sent, not output)
+    \item OASIS\_ToRest (=6) if the field was written to a restart
+      file only
+    \item OASIS\_Output (=7) if the field was written to an output
+      file only
+    \item OASIS\_SentOut (=8) if the field was both written to an
+      output file and sent to another model (directly or via OASIS3
+      main process)
+    \item OASIS\_ToRestOut (=9) if the field was written both to a
+      restart file and to an output file.
+    \item OASIS\_Waitforallingroup (=14) if the field was not sent because it is in a group.
+    It will be sent only when the oasis\_put of the last field in the group will be called.
+    \item OASIS\_Ok (=0) otherwise and no error occurred.
+    \end{itemize}
+  \end{itemize}
+
+This routine may be called at any time to
+inquire what would happen to the corresponding field (i.e. with same
+{\tt var\_id} and at same {\tt date}) below the corresponding {\tt
+  oasis\_put}.
+
+\item {\tt CALL oasis\_get\_ncpl(var\_id, ncpl, kinfo)}
+\item {\tt CALL prism\_get\_ncpl\_proto(var\_id, ncpl, kinfo)}
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; IN]}: field ID (from
+  corresponding oasis\_def\_var)
+  \item {\tt ncpl [INTEGER; OUT]}: number of couplings in which the field
+  is involved (i.e. when a field is sent to multiple targets) 
+  \item {\tt kinfo [INTEGER; OUT]}: returned info code
+  \end{itemize}
+
+This routine returns the number of coupling in which the field var\_id is
+involved. This number is needed to get the coupling frequencies with the
+routine oasis\_get\_freqs, see below.
+
+\item {\tt CALL oasis\_get\_freqs(var\_id, ncpl, cpl\_freqs, kinfo)}
+\item {\tt CALL prims\_get\_freqs\_proto(var\_id, ncpl, cpl\_freqs, kinfo)}
+  \begin{itemize}
+  \item {\tt var\_id [INTEGER; IN]}: field ID (from
+  corresponding oasis\_def\_var)
+  \item {\tt ncpl [INTEGER; IN]}: number of couplings in which the field
+  is involved (i.e. when a field is sent to multiple targets)
+   \item {\tt cpl\_freqs [INTEGER; DIMENSION(ncpl); OUT]}: periods of coupling 
+  (in number of seconds) of field var\_id. There is one coupling period for
+  each coupling in which the field is involved
+  \item {\tt kinfo [INTEGER; OUT]}: returned info code
+  \end{itemize}
+
+This routine can be used to retrieve the coupling period(s) of field with
+corresponding {\tt var\_id}, as defined in the {\it namcouple}
+
+\end{itemize}
+
+\section{Coupling algorithms - SEQ and LAG concepts}
+\label{subsubsec_Algoritms}
+
+Using the OASIS3-MCT coupling library, the user has full flexibility
+to reproduce different coupling algorithms. In the components, the
+sending and receiving routines, respectively {\tt oasis\_put} and {\tt
+  oasis\_get}, can be called at each model timestep, with the
+appropriate {\tt date} argument giving the actual time (at the
+beginning of the timestep), expressed in number of seconds since the
+start of the run or in any other time units, as long as the same are
+used in all models and in the {\it namcouple} (see section
+\ref{prismput}). This {\tt date} argument is automatically analysed by
+the coupling library and depending on the coupling period and the lag
+(LAG) chosen by the user for each coupling field in the configuration
+file {\it namcouple}, different coupling algorithms can be reproduced
+without modifying the component model codes themselves.
+
+With OASIS3-MCT, the SEQ index is no longer needed in the {\it
+  namcouple} input to specify the sequencing order of different
+coupling fields.  The sequence (SEQ) index in the {\it namcouple} file
+now provides the coupling layer with an ability to detect a deadlock
+before it happens and exit.
+
+The lag concept and indices are explained in more detail below and
+some examples are provided.
+
+\vspace{-0.3cm}
+\subsection{The lag concept}
+\label{subsub_lag}
+
+The lag (LAG) value tells the coupler to modify the time at which that
+data is sent (put) by the amount of the lag.  The lag must be
+expressed in the time unit used (that must be the same in the models
+and in the {\it namcouple}, see section \ref{prismput}) and can be
+positive or negative but should never be larger (in absolute
+magnitude) than the coupling period of any field due to problems with
+restartability and dead-locking. When a component model calls a {\tt
+  oasis\_put}, the value of the lag is automatically added to the
+value of the {\tt date} argument and the ``put'' is actually performed
+when the sum {\tt date+lag} is a coupling time; in the target
+component, this ``put'' will match a {\tt oasis\_get} for which the
+{\tt date} argument is the same coupling time.
+% A positive lag indicates the put will occur sooner than zero lag and
+% a negative lag tells the coupler to send the data later than zero
+% lag.
+The lag only shifts the time data is sent.  It cannot be used to shift
+the time data is received yet.
+ 
+When the lag is positive, a restart file must be available to initiate
+the coupling and in those cases, the restart file is then updated at
+the end of the run.  A positive lag acts like a send occurred before
+the model started. In fact, for a field with positive lag, the source
+component model automatically reads the field in the restart file
+during the coupling initialization phase (below the {\tt
+  oasis\_enddef}) and send the data to match the {\tt oasis\_get}
+performed at time=0 in the target component model. The final coupling
+data on the source side will then be automatically written to the
+restart file for use in the next run.
+
+When there is a lag, the first and last instance of the source field
+in the debug netCDF file (EXPOUT fields, see section
+\ref{subsec_namcouplesecond}) always correspond respectively to the
+field read from and written to the restart file.
+ 
+\begin{enumerate}
+
+\item LAG concept first example
+ 
+  A first coupling algorithm, exploiting the LAG concept, is
+  illustrated on figure \ref{fig:lag_concept_1}.
+
+  On the 4 figures in this section, short black arrows correspond to
+  {\tt oasis\_put} or {\tt oasis\_get} called in the component model
+  that do not lead to any ``put" or receiving action; long black
+  arrows correspond to {\tt oasis\_put} or {\tt oasis\_get} called in
+  the component models that do actually lead to a ``put" or ``get''
+  action; long red arrows correspond to {\tt oasis\_put} or {\tt
+    oasis\_get} called in the component models that lead to a reading
+  or writing of the coupling field from or to a coupling restart file.
+
+  \begin{figure}
+    \includegraphics[scale=.6]{figures/fig_lag_concept_1}
+    \caption{LAG concept first example}
+    \label{fig:lag_concept_1}
+  \end{figure}
+
+  During a coupling timestep, model A receives $F_2$ and then sends
+  $F_1$; its timestep length is 4. During a coupling timestep, model B
+  receives $F_1$ and then sends $F_2$; its timestep length is 6.
+  $F_1$ and $F_2$ coupling periods are respectively 12 and 24. If
+  $F_1$/$F_2$ ``put" action by model A/B was used at a coupling
+  timestep to match the model B/A ``get" action, a deadlock would
+  occur as both models would be initially waiting on a ``get"
+  action. To prevent this, $F_1$ and $F_2$ produced at the timestep
+  before have to be used to match respectively the model B and model A
+  ``get" actions.
+
+  This implies that a lag of respectively 4 and 6 seconds must be
+  defined for $F_1$ and $F_2$. For $F_1$, the {\tt oasis\_put}
+  performed at time 8 and 20 by model A will then lead to ``put"
+  actions (as 8 + 4 = 12 and 20 + 4 = 24 which are coupling periods)
+  that match the ``get" actions performed at times 12 and 24 below the
+  {\tt oasis\_get} called by model B.  For $F_2$, the {\tt oasis\_put}
+  performed at time 18 by model B then leads to a ``put" action (as 18
+  + 6 = 24 which is a coupling period) that matches the ``get" action
+  performed at time 24 below the {\tt oasis\_get} called by model A.
+
+  At the beginning of the run, as their LAG index is greater than 0,
+  the first {\tt oasis\_get} of $F_1$ and $F_2$ will automatically be
+  fulfilled with fields read from their respective coupling restart
+  files. The user therefore has to create those coupling restart files
+  before the first run in the experiment. At the end of the run, $F_1$
+  having a lag greater than 0, is automatically written to its
+  coupling restart file below the last $F_1$ {\tt oasis\_put} as the
+  {\tt date+lag} equals the total run time. The analogue is true for
+  $F_2$. These values will automatically be read in at the beginning
+  of the next run below the respective {\tt oasis\_get}.
+
+\item LAG concept second example
+
+  A second coupling algorithm exploiting the LAG concept is
+  illustrated on figure \ref{fig:lag_concept_2}. During its timestep,
+  model A receives $F_2$, sends $F_3$ and then $F_1$; its timestep
+  length is 6. During its timestep, model B receives $F_1$, receives
+  $F_3$ and then sends $F_2$; its timestep length is also 6.  $F_1$,
+  $F_2$ and $F_3$ coupling periods are both supposed to be equal to
+  12.
+ 
+  \begin{figure}
+    \includegraphics[scale=.6]{figures/fig_lag_concept_2}
+    \caption{LAG concept second example}
+    \label{fig:lag_concept_2}
+  \end{figure}
+
+  For $F_1$ and $F_2$ the situation is similar to the first
+  example. If $F_1$/$F_2$ ``put" action by model A/B was used at a
+  coupling timestep to match the model B/A ``get" action, a deadlock
+  would occur as both models would be waiting on a ``get" action. To
+  prevent this, $F_1$ and $F_2$ produced at the timestep before have
+  to be used to match the model A and model B ``get" actions, which
+  means that a lag of 6 must be defined for both $F_1$ and $F_2$. For
+  both coupling fields, the {\tt oasis\_put} performed at times 6 and
+  18 by the source model then lead to ``put" actions (as 6 + 6 = 12
+  and 18 + 6 = 24 which are coupling periods) that match the ``get"
+  action performed at time 12 and 24 below the {\tt oasis\_get} called
+  by the target model.
+
+  For $F_3$, sent by model A and received by model B, no lag needs to
+  be defined: the coupling field produced by model A at the coupling
+  timestep can be ``consumed'' by model B without causing a deadlock
+  situation.
+
+  As in the first example, the {\tt oasis\_get} performed at the
+  beginning of the run for $F_1$ and $F_2$, will automatically receive
+  data read from their coupling restart files, and the last {\tt
+    oasis\_put} performed at the end of the run automatically write
+  them to their coupling restart file. For $F_3$, no coupling restart
+  file is needed nor used as at each coupling period the coupling
+  field produced by model A can be directly ``consumed'' by model B.
+
+  We see here how the introduction of appropriate LAG indices results
+  in receiving in the target model the coupling fields produced by the
+  source model the timestep before; this is, in some coupling
+  configurations, essential to avoid deadlock situations.
+
+\end{enumerate}
+
+\vspace{-0.3cm}
+\subsection{The sequence concept}
+\label{subsec_sec}
+
+The order of coupling operations in the system is determined solely by
+the order of calls to send (put) and receive (get) data in the models
+in conjunction with the setting of the lag in the {\it namcouple}.
+Data that is received (get) is always blocking while data that is sent
+(put) is non-blocking with respect to the model making that call.  It
+is possible to deadlock the system if the relative orders of puts and
+gets in different models are not compatible.
+
+With OASIS3-MCT, the sequence (SEQ) index in the {\it namcouple} file
+now provides the coupling layer with an ability to detect a deadlock
+before it happens and exit.  It does this by tracking the order of get
+and put calls in models compared to the SEQ specified in the {\it
+  namcouple}.  If there are any inconsistencies, the model will abort
+gracefully with a useable error message before the system deadlocks.
+If there are any coupling dependencies in the system, use of the SEQ
+index is recommended for diagnosis but has no impact on the ultimate
+solution and is NOT required.
+
+Take the following two examples.  In both examples, there are two
+models, each ``put" a field to the other at every coupling period
+without any lags.  In the first case, there is no dependency and each
+model sends (puts) the data first and then receives the data second at
+each timestep.
+
+\begin{verbatim}
+     model1        model2
+     ------        ------
+    put(fld1)     put(fld2)
+    get(fld2)     get(fld1)
+\end{verbatim}
+
+The put from model1 for fld1 is received by the get in model2 and the
+put from model2 for fld2 is received by the get in model1.  In this
+case, there is no sequencing dependency and the value of SEQ must be
+identical (or unset) in the {\it namcouple} description of the fld1
+and fld2 coupling.  If SEQ is set to 1 for fld1 and 2 for fld2 in this
+case, then the model will abort because at runtime, the coupling will
+detect, in model 2, that fld2 was sent before fld1 was received which
+is out of sequence as defined by the SEQ settings.
+
+In the next example, there is a dependency in the sequencing.
+
+\begin{verbatim}
+     model1        model2
+     ------        ------
+    put(fld1)     get(fld1)
+                  fld2=g(fld1)
+    get(fld2)     put(fld2)
+\end{verbatim}
+
+In model2, fld2 depends on fld1.  If this dependency is known, then
+there is a benefit in using SEQ=1 for fld1 and SEQ=2 for fld2.  At
+runtime, if the sequencings of both model1 and model2 do not match the
+above diagram, the model will abort gracefully.  For instance, if
+model2 has the dependency shown above but model1 does not have
+consistent ordering of the put and get as required by model2, then if
+SEQ is unused, the model will deadlock and hang.  If SEQ is set
+properly, the coupling layer will detect that the required sequence
+has not been followed and will exit gracefully with an error message.
+
+Again, the SEQ namecouple setting is only diagnostic and is not
+required.
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG3_Namcouple_generation.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG3_Namcouple_generation.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG3_Namcouple_generation.tex	(revision 4775)
@@ -0,0 +1,391 @@
+\newpage
+\chapter{The configuration file {\it namcouple}}
+\label{sec_namcouple}
+
+The OASIS3-MCT configuration file {\it namcouple} contains, below
+pre-defined keywords, all user's defined information necessary to
+configure a particular coupled run.
+
+The {\it namcouple} is a text file with the following characteristics:
+
+\begin{itemize}
+\item the keywords used to separate the information can appear in any
+  order;
+\item the number of blanks between two character strings is
+  non-significant;
+\item all lines beginning with \# are ignored and considered as
+  comments.
+\item {\bf blank lines are not allowed.}
+\end{itemize}
+
+The first part of {\it namcouple } is devoted to configuration of
+general parameters such as the number of models involved in the
+simulation or the number of fields.  The second part gathers specific
+information on each coupling (or I/O) field, e.g. their coupling
+period, the list of transformations or interpolations to be performed
+by OASIS3-MCT and associated configuring lines (described in more
+details in chapter \ref{sec_transformations}), etc.
+
+In OASIS3-MCT, several {\it namcouple} inputs have been deprecated
+but, for backwards compatibility, they are still allowed.  These
+inputs will be noted in the following text using the notation
+``UNUSED'' and not fully described. Information below these keywords
+is obsolete in OASIS3-MCT; it will not be read and will not be used.
+
+In the next sections, a simple {\it namcouple} example is given and
+all configuring parameters are described. The additional lines
+containing the different parameters required for each transformation
+are described in section \ref{sec_transformations}. A realistic {\it
+  namcouple} can be found in {\tt
+  oasis3-mct/examples/tutorial/data\_oasis3/} directory.
+
+\section{An example of a simple {\it namcouple}}
+\label{subsec_examplenamcouple}
+
+The following simple {\it namcouple} configures a run into which an
+ocean, an atmosphere and an atmospheric chemistry models are
+coupled. The ocean provides only the SOSSTSST field to the atmosphere,
+which in return provides the field CONSFTOT to the ocean. One field
+(COSENHFL) is exchanged from the atmosphere to the atmospheric
+chemistry, and one field (SOALBEDO) is read from a file by the ocean.
+
+\begin{verbatim}
+######################################################################
+# First section
+#
+ $SEQMODE
+#
+ $CHANNEL
+#
+ $NFIELDS
+    4  
+#
+ $JOBNAME
+#
+ $NBMODEL
+    3  ocemod   atmmod  chemod  55  70   99 
+#
+ $RUNTIME
+    432000
+#
+ $INIDATE
+#
+ $MODINFO
+#
+ $NLOGPRT
+   2     1
+#
+ $CALTYPE
+#
+######################################################################
+# Second section 
+ $STRINGS
+#
+# Field 1
+ SOSSTSST SISUTESU 1 86400  5  sstoc.nc  EXPORTED
+ 182  149  128  64  toce  atmo   LAG=+14400  SEQ=+1
+ P 2 P 0
+ LOCTRANS CHECKIN MAPPING  BLASNEW CHECKOUT 
+#
+  AVERAGE 
+  INT=1
+  map_toce_atmo_120315.nc src opt
+  1.0  1
+  CONSTANT     273.15 
+  INT=1
+#
+# Field 2
+ CONSFTOT SOHEFLDO 6 86400  4   flxat.nc  EXPORTED
+ atmo   toce  LAG=+14400  SEQ=+2
+ P 0 P 2
+ LOCTRANS  CHECKIN  SCRIPR CHECKOUT
+#
+  ACCUMUL 
+  INT=1
+  BILINEAR LR SCALAR LATLON 1
+  INT=1
+#
+# Field 3
+ COSENHFL  SOSENHFL  37  86400   1  flda3.nc  IGNOUT 
+ atmo   atmo LAG=+7200 
+ LOCTRANS
+ AVERAGE
+#
+# Field 4
+ SOALBEDO SOALBEDO  17  86400  0  SOALBEDO.nc  INPUT
+#####################################################################
+ $END
+\end{verbatim}
+
+% section{An example of a simple {\it namcouple}}
+
+\section{ First section of {\it namcouple} file}
+\label{subsec_namcouplefirst}
+
+The first section of {\it namcouple } uses some predefined keywords
+prefixed by the \$ sign to locate the related information. The \$ sign
+must be in the second column. The first ten keywords are described
+hereafter:
+
+\begin{itemize}
+
+\item {\tt \$SEQMODE}: UNUSED
+
+\item {\tt \$CHANNEL}: UNUSED
+
+\item {\tt \$NFIELDS}: On the line below this keyword is the total
+  number of field entries in the second part of the {\it
+    namcouple}. If more than one field are described on the same line
+  (new in OASIS3-MCT\_1.0, see appendix \ref{sec_changes_new}) this
+  counts as only one entry.
+
+\item {\tt \$JOBNAME}: UNUSED
+
+\item {\tt \$NBMODEL}: On the line below this keyword is the number of
+  models running in the given experiment followed by {\tt
+    CHARACTER$\star$6} variables giving their names, which must
+  correspond to the name announced by each model when calling {\tt
+    oasis\_init\_comp} (second argument, see section
+  \ref{subsubsec_Initialisation}).
+
+  Then the user may indicate on the same line the maximum Fortran unit
+  number used by the models. In the example, Fortran units above 55,
+  70, and 99 are free for respectively the ocean, atmosphere, and
+  atmospheric chemistry models. {\bf In all cases, OASIS3-MCT library
+    assumes, during the initialization phase, that units 1025 and 1026
+    are free and temporarily uses these units to read the {\it
+      namcouple} and to write corresponding log messages to file {\tt
+      nout.000000}.} After the initialization phase, OASIS3-MCT will
+  still suppose that units above 1024 are free, unless maximum unit
+  numbers are indicated here in the {\it namcouple}.
+  % If {\tt \$CHANNEL} is {\tt NONE}, {\tt \$NBMODEL} has to be 0 and
+  % there should be no model name and no unit number.
+
+\item {\tt \$RUNTIME}: On the line below this keyword is the total
+  simulated time of the run, expressed in seconds (or any other time
+  units as long as the same are used in all models and in the {\it
+    namcouple}, see \ref{subsubsec_sendingreceiving}).
+  % If {\tt \$CHANNEL} is {\tt NONE}, {\tt \$RUNTIME} has to be the
+  % number of time occurrences of the field to interpolate from the
+  % restart file.
+
+\item {\tt \$INIDATE}: UNUSED
+
+\item {\tt \$MODINFO}: UNUSED
+ 
+\item {\tt \$NLOGPRT}: The first and second numbers on the line below
+  this keyword refer to the amount of debug and time statistic
+  information written by OASIS3-MCT for each model and processor.
+
+  The first number (that can be changed at runtime with the {\tt
+    oasis\_set\_debug} routine, see section
+  \ref{subsubsec_auxroutines}) may be:
+  \begin{itemize}
+  \item 0 : one file debug.root.xx is open by the master proces of
+    each model and one file debug\_notroot.xx is open for all the
+    other processes of each model to write only error information.
+  \item 1 : one file debug.root.xx is open by the master proces of
+    each model to write information equivalent to level 10 (see
+    below); one file debug\_notroot.xx is open for all the other
+    processes of each model to write error information.
+  \item 2 : one file debug.xx.xxxxxx is open by each process of each
+    model to write normal production diagnostics
+  \item 5 : as for 2 with in addition some initial debug info
+  \item 10: as for 5 with in addition the routine calling tree
+  \item 12: as for 10 with in addition some routine calling notes
+  \item 15: as for 12 with even more debug diagnostics
+  \item 20: as for 15 with in addition some extra runtime analysis
+  \item 30: full debug information
+  \end{itemize}
+  The second number defines how time statistics are written out to
+  file {\tt *.timers\_xxxx}; it can be:
+  \begin{itemize}
+  \item 0 : nothing is calculated, nothing is written.
+  \item 1 : some time statistics are calculated and written in a
+    single file by the processor 0 as well as the min and the max
+    times over all the processors.
+  \item 2 : some time statistics are calculated and each processor
+    writes its own file ; processor 0 also writes the min and the max
+    times over all the processors in its file.
+  \item 3 : some time statistics are calculated and each processor
+    writes its own file ; processor 0 also writes in its file the min
+    and the max times over all processors and also writes in its file
+    all the results for each processor.
+  \end{itemize}
+  For more information on the time statistics written out, see section
+  \ref{timestat}.
+
+\item {\tt \$CALTYPE}: UNUSED
+
+\end{itemize}
+
+% {Description of {\it namcouple} first section}
+
+\section{Second section of {\it namcouple} file }
+\label{subsec_namcouplesecond}
+
+The second part of the {\it namcouple}, starting after the keyword
+{\tt \$STRINGS}, contains coupling information for each coupling (or
+I/O) field.  Its format depends on the field status given by the last
+entry on the field first line ({\tt EXPORTED}, {\tt IGNOUT} or {\tt
+  INPUT} in the example above). The field may be :
+
+\begin{itemize}
+\item {\tt AUXILARY}: UNUSED
+\item {\tt EXPORTED}: exchanged between component models and
+  transformed by OASIS3-MCT
+\item {\tt EXPOUT}: exchanged, transformed and also written to two
+  debug NetCDF files, one before the sending action in the source
+  model below the {\tt oasis\_put} call (after local transformations
+  {\tt LOCTRANS} and {\tt BLASOLD} if present), and one after the
+  receiving action in the target model below the {\tt oasis\_get} call
+  (after all transformations). {\tt EXPOUT} should be used when
+  debugging the coupled model only. The name of the debug NetCDF file
+  (one per field) is automatically defined based on the field and
+  component model names.
+\item {\tt IGNORED}: with OASIS3-MCT, this setting is equivalent to
+  and converted to EXPORTED
+\item {\tt IGNOUT}: with OASIS3-MCT, this setting is equivalent to and
+  converted to EXPOUT
+\item {\tt INPUT}: read in from the input file by the target model
+  below the {\tt oasis\_get} call at
+  appropriate times corresponding to the input period indicated by the
+  user in the {\it namcouple}. See section \ref{subsec_inputdata} for
+  the format of the input file.
+\item {\tt OUTPUT}: written out to an output debug NetCDF file by the
+  source model below the {\tt oasis\_put} call, after local
+  transformations {\tt LOCTRANS} and {\tt BLASOLD}, at appropriate
+  times corresponding to the output period indicated by the user in
+  the {\it namcouple}.
+
+\end{itemize}
+
+\subsection{Second section of {\it namcouple} for {\tt EXPORTED} and
+  {\tt EXPOUT} fields}
+\label{subsubsec_secondEXPORTED}
+
+The first 3 lines for fields with status {\tt EXPORTED} and {\tt
+  EXPOUT} are as follows:
+  \begin{verbatim}
+   SOSSTSST SISUTESU 1 86400  5  sstoc.nc  EXPORTED
+   182  149    128  64  toce  atmo   LAG=+14400 SEQ=+1
+   P 2 P 0 
+\end{verbatim}
+%\vspace{-0.2cm} 
+where the different entries are:
+\begin{itemize}
+\item Field first line:
+  \begin{itemize}
+  \item {\tt SOSSTSST} : symbolic name for the field in the source
+    model ({\tt CHARACTER*128}). It has to match the argument {\tt name}
+    of the corresponding field declaration in the source model; see
+    {\tt oasis\_def\_var} in section \ref{subsubsec_Declaration}
+  \item {\tt SISUTESU} : symbolic name for the field in the target
+    model ({\tt CHARACTER*128}).  It has to match the argument {\tt
+      name} of the corresponding field declaration in the target
+    model; see {\tt oasis\_def\_var} in section
+    \ref{subsubsec_Declaration}
+  \item 1 : UNUSED but still required for parsing
+  \item 86400 : coupling and/or I/O period for the field, in seconds
+  \item 5 : number of transformations to be performed by OASIS3 on
+    this field
+  \item sstoc.nc : name of the coupling restart file for the field
+    ({\tt CHARACTER*8}); mandatory even if no coupling restart file is
+    effectively used (for more detail, see section
+    \ref{subsec_restartdata})
+  \item {\tt EXPORTED} : field status
+  \end{itemize}
+\item Field second line:
+  \begin{itemize}
+  \item 182 : number of points for the source grid first dimension
+    (optional)
+  \item 149 : number of points for the source grid second dimension
+    (optional)\footnote{For 1D field, put {\tt 1} as the second dimension}
+  \item 128 : number of points for the target grid first dimension
+    (optional)
+  \item 64 : number of points for the target grid second dimension
+    (optional)$^{1}$
+
+    {\bf These source and target grid dimensions are optional but note that
+    in order to have 2D fields written as 2D arrays in the debug
+    files, these dimensions must be provided in the {\it namcouple};
+    otherwise, the fields will be written out as 1D arrays.}
+  
+  \item toce : prefix of the source grid name in grid data files (see
+    section \ref{subsec_griddata}) ({\tt CHARACTER*4})
+  \item atmo : prefix of the target grid name in grid data files ({\tt
+      CHARACTER*4})
+  \item {\tt LAG=+14400}: optional lag index for the field (see section \ref{subsub_lag})
+  \item {\tt SEQ=+1}: optional sequence index for the field (see
+    section \ref{subsec_sec})
+  \end{itemize}
+\item Field third line
+  \begin{itemize}
+  \item P : source grid first dimension characteristic (`P':
+    periodical; `R': regional).
+  \item 2 : source grid first dimension number of overlapping grid
+    points.
+  \item P : target grid first dimension characteristic (`P':
+    periodical; `R': regional).
+  \item 0 : target grid first dimension number of overlapping grid
+    points.
+  \end{itemize}
+     
+\end{itemize}
+    
+The fourth line gives the list of transformations to be performed for
+this field. In addition, there is one or more configuring lines
+describing some parameters for each transformation. These additional
+lines are described in more details in the chapter
+\ref{sec_transformations}.
+
+\subsection{Second section of {\it namcouple} for {\tt OUTPUT} fields}
+\label{subsubsec_secondOUTPUT}
+The first 2 lines for fields with status {\tt OUTPUT} are as follows:
+  \begin{verbatim}
+  COSHFTOT  COSHFTOT   7   86400  0  fldhftot.nc OUTPUT 
+  atmo   atmo 
+\end{verbatim}
+% \vspace{-0.2cm}
+where the different entries are as for {\tt EXPOUT} fields, except
+that:
+\begin{itemize}
+\item the source symbolic name must be repeated twice on the field
+  first line,
+\item the restart file name (here {\tt fldhftot.nc}) is needed only if
+  a {\tt LOCTRANS} transformation is present,
+\item there is no output file name on the first line,
+\item there is no grid dimension\footnote{This means that all output
+    fields will be written out in the output files as 1D arrays (this
+    should be fixed in the next OASIS3-MCT version).} and no LAG or SEQ
+  index on the second line; ;
+\end{itemize}
+The name of the output file is automatically defined based on the
+field and component model names.
+
+The third line is {\tt LOCTRANS} if this transformation is chosen for
+the field. Note that {\tt LOCTRANS} is the only transformation
+supported for {\tt OUTPUT} fields.
+
+\subsection{Second section of {\it namcouple} for {\tt INPUT} fields}
+\label{subsubsec_secondINPUT}
+
+The first and only line for fields with status {\tt INPUT} is:
+
+  \begin{verbatim}
+  SOALBEDO SOALBEDO  17  86400  0  SOALBEDO.nc  INPUT
+  \end{verbatim}
+\vspace{-0.5cm}
+where the different entries are:
+\begin{itemize}
+\item {\tt SOALBEDO}: symbolic name for the field in the target model
+  ({\tt CHARACTER*128} repeated twice)
+\item 17: index in auxiliary file cf\_name\_table.txt (see above for
+  EXPORTED fields)
+\item 86400: input period in seconds
+\item 0: number of transformations (always 0 for {\tt INPUT} fields)
+\item {\tt SOALBEDO.nc}: {\tt CHARACTER*32} giving the input file name
+  (for more detail on its format, see section \ref{subsec_inputdata})
+\item {\tt INPUT}: field status.
+\end{itemize}
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG4_Transformations.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG4_Transformations.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG4_Transformations.tex	(revision 4775)
@@ -0,0 +1,705 @@
+\newpage
+\chapter{Transformations and interpolations}
+\label{sec_transformations}
+
+Different transformations and 2D interpolations are available in
+OASIS3-MCT to adapt the coupling fields from a source model grid to a
+target model grid.  In the following paragraphs, a description of each
+transformation with its corresponding configuration lines that the
+user has to write in the {\it namcouple} file is given.  Features that
+are now deprecated (non functional) compared to prior versions will be
+noted with the string UNUSED but not described.
+
+\section{Time transformations}
+\label{subsec_timetrans}
+
+\begin{itemize}
+
+\item {\bf LOCTRANS}:
+
+  {\tt LOCTRANS} requires one configuring line on which a time
+  transformation, automatically performed below the call to {\tt
+    oasis\_put}, should be indicated:
+
+  \begin{verbatim}
+ # LOCTRANS operation
+   $TRANSFORM
+\end{verbatim}
+  % $
+  \vspace{-0.2cm} where {\tt \$TRANSFORM} can be
+  \begin{itemize}
+  \item {\tt INSTANT}: no time transformation, the instantaneous field
+    is transferred;
+  \item {\tt ACCUMUL}: the field accumulated over the previous
+    coupling period is exchanged (the accumulation is simply done over
+    the arrays {\tt field\_array} provided as third argument to the
+    {\tt oasis\_put} calls, not weighted by the time interval between
+    these calls);
+  \item {\tt AVERAGE}: the field averaged over the previous coupling
+    period is transferred (the average is simply done over the arrays
+    {\tt field\_array} provided as third argument to the {\tt
+      oasis\_put} calls, not weighted by the time interval between
+    these calls);
+  \item {\tt T\_MIN}: the minimum value of the field for each source
+    grid point over the previous coupling period is transferred;
+  \item {\tt T\_MAX}: the maximum value of the field for each source
+    grid point over the previous coupling period is transferred;
+  \item {\tt ONCE}: UNUSED ; {\bf not supported in OASIS3-MCT.}
+  \end{itemize}
+
+  With OASIS3-MCT, time transformations are supported more generally
+  with use of the coupling restart file.  The coupling restart file
+  allows the partial time transformation to be saved at the end of a
+  run for exact restart at the start of the next run.  For that
+  reason, coupling restart filenames are now required for all {\it
+    namcouple} entries that use LOCTRANS (with non INSTANT
+  values). This is the reason an optional restart file is now provided
+  on the OUTPUT {\it namcouple} input line.
+
+\end{itemize}
+
+\section{The pre-processing transformations}
+\label{subsec_preproc}
+
+\begin{itemize}
+
+\item {\bf REDGLO} UNUSED
+
+\item {\bf INVERT}: UNUSED
+
+\item {\bf MASK}: UNUSED
+ 
+\item {\bf EXTRAP}: UNUSED
+
+\item {\bf CHECKIN}:
+
+  {\tt CHECKIN} calculates the global minimum, the maximum and the sum
+  of the source field values (not weighted by the grid cell area) and
+  prints them to the OASIS3-MCT debug file (for the master process of
+  the source component model only). These informations are found in 
+  the debug file of the master process of the source model under the 
+  attribute ``diags''. 
+  This operation does not transform the field.
+
+  The generic input line is as follows:
+ \begin{verbatim}
+ # CHECKIN operation
+     INT = 1  
+\end{verbatim} 
+
+\item {\bf CORRECT}: UNUSED
+
+\item {\bf BLASOLD}:
+
+  {\tt BLASOLD} allows the source field to be scaled and allows a
+  scalar to be added to the field.  The prior ability to perform a
+  linear combination of the current coupling field with other coupling
+  fields has been deprecated in OASIS3-MCT.  This transformation
+  occurs before the interpolation {\it per se}.
+
+  This transformation requires at least one configuring line with two
+  parameters:
+ \begin{verbatim}
+# BLASOLD operation
+     $XMULT   $NBFIELDS 
+\end{verbatim}
+  % \vspace{-0.2cm}
+  where {\tt \$XMULT} is the multiplicative coefficient of the source
+  field, which must be given as a REAL value (e.g 2.0 and not 2). {\tt
+    \$NBFIELDS} must be 0 if no scalar needs to be added or 1 if a
+  scalar needs to be added. In this last case, an additional input
+  line is required where {\tt \$AVALUE} is the scalar to be added to
+  the field, which must also be given as a REAL value :
+\begin{verbatim}
+     CONSTANT  $AVALUE
+\end{verbatim} 
+\end{itemize}
+
+% subsection{The pre-processing transformations}
+
+\section{The remapping (interpolation)}
+\label{subsec_interp}
+
+\begin{itemize}
+
+\item {\bf MAPPING}:
+
+  The {\tt MAPPING} keyword is used to specify an input file to be
+  read and used for mapping (ie. regridding or interpolation); the
+  {\tt MAPPING} file must follow the {\tt SCRIPR} format.  This is an
+  alternative method to {\tt SCRIPR} for setting the mapping file.
+ 
+  Since OASIS3-MCT\_2.0, {\tt MAPPING} can be used for higher order
+  remapping. Up to 5 different sets of weights (see section
+  \ref{subsec_mapdata} for the weight file format) can be applied to
+  up to 5 different fields transfered as {\tt oasis\_put} arguments
+  (see section \ref{prismput}).
+
+  This transformation requires at least one configuring line with one
+  filename and two optional string values:
+\begin{verbatim}
+     $MAPNAME  $MAPLOC  $MAPSTRATEGY
+\end{verbatim}
+  \begin{itemize}
+  \item {\tt \$MAPNAME} is the name of the mapping file to read.  This
+    is a NetCDF file consistent with the SCRIPR map file format (see
+    section \ref{subsec_inputdata}).
+
+  \item {\tt \$MAPLOC} is optional and can be either {\tt src} or {\tt
+      dst}.  With {\tt src}, the mapping will be done in parallel on
+    the source processors before communication to the destination
+    model processes; this is the default.  With {\tt dst}, the mapping
+    is done on the destination processes after the source grid data is
+    sent from the source model.
+
+  \item {\tt \$MAPSTRATEGY} is optional and can be either {\tt bfb},
+    {\tt sum}, or {\tt opt}.  In {\tt bfb} mode, the mapping is done
+    using a strategy that produces bit-for-bit identical results
+    regardless of the grid decompositions without leveraging a partial
+    sum computation; this is the default.  With {\tt sum}, the
+    transform is done using the partial sum approach which generally
+    introduces roundoff level changes in the results on different
+    processor counts. Option {\tt opt} allows the coupling layer to
+    choose either approach based on an analysis of which strategy is
+    likely to run faster. Usually, partial sums will be used if the
+    source grid has a higher resolution than the target grid as this
+    should reduce the overall communication (e.g. for conservative
+    remapping).
+
+  \end{itemize}
+
+  Note that if {\tt SCRIPR} (see below) is used to calculate the
+  remapping file, {\tt MAPPING} can still be listed in the {\tt
+    namcouple} to specify a name for the remapping file generated by
+  {\tt SCRIPR} different from the default and/or to specify a {\tt
+    \$MAPLOC} or {\tt \$MAPSTRATEGY} option.
+
+\item {\bf SCRIPR}:
+ 
+  {\tt SCRIPR} gathers the interpolation techniques offered by Los
+  Alamos National Laboratory SCRIP 1.4 library
+  \citep{Jones99}\footnote{See also
+    http://climate.lanl.gov/Software/SCRIP/ and the copyright
+    statement in appendix \ref{sec_SCRIP}.}.  {\tt SCRIPR} routines
+  are in {\tt oasis3-mct/lib/scrip}. See the SCRIP 1.4 documentation
+  in {\tt oasis3/doc/SCRIPusers.pdf} for more details on the
+  interpolation algorithms.
+
+  When the SCRIP library performs a remapping, it first checks if the
+  file containing the corresponding remapping weights and addresses
+  exists; if it exists, it reads them from the file; if not, it
+  calculates them and store them in a file. The file is created in the
+  working directory and is called {\tt rmp\_{\it srcg}\_to\_{\it
+      tgtg}\_{\it INTTYPE}\_{\it NORMAOPT}.nc}, where {\it srcg} and
+  {\it tgtg} are the acronyms of respetively the source and the target
+  grids, {\it INTTYPE} is the interpolation type, i.e. {\tt DISTWGT},
+  {\tt GAUSWGT}, {\tt BILINEAR} ({\bf not BILINEA as in OASIS3.3}) or
+  {\tt CONSERV} -see below, and {\it NORMAOPT} is the normalization
+  option, i.e. {\tt DESTAREA}, {\tt FRACAREA} or {\tt FRACNNEI} for
+  {\tt CONSERV} only -see below). One has to take care that the
+  remapping file will have the same name even if other details, like
+  the grid masks, are changed. When reusing a remapping file, one has
+  to be sure that it was generated in exactly the same conditions than
+  the ones it is used for.
+
+  The following types of interpolations are available:
+
+  \begin{itemize}
+
+  \item {\tt DISTWGT} performs a distance weighted nearest-neighbour
+    interpolation (N neighbours). All types of grids are supported.
+
+    \begin{itemize}
+
+    \item Masked target grid points: the zero value is associated to
+      masked target grid points.
+
+    \item Non-masked target grid points having some of the N source
+      nearest neighbours masked: a nearest neighbour algorithm using
+      the remaining non masked source nearest neighbours is applied.
+
+    \item Non-masked target grid points having all of the N source
+      nearest neighbours masked: by default, the nearest non-masked
+      source neighbour is used (logical {\tt ll\_nnei} hard-coded to
+      {\tt .true.} in {\tt oasis3-mct/lib/scrip/src/remap\_distwgt.F};
+      same default behaviour as OASIS3.3).
+
+    \end{itemize}
+
+    The configuring line is:
+
+  \begin{verbatim}
+ # SCRIPR (for DISWGT) 
+     $CMETH $CGRS $CFTYP $REST $NBIN $NV $ASSCMP $PROJCART
+\end{verbatim} 
+    where:
+    % \vspace{-0.5cm}
+    \begin{itemize}
+    \item {\tt \$CMETH = DISTWGT}.
+    \item {\tt \$CGRS} is the source grid type ({\tt LR}, {\tt D} or
+      {\tt U})- see appendix \ref{subsec_gridtypes}.
+
+    \item {\tt \$CFTYP} is the field type: {\tt SCALAR}. The option
+      {\tt VECTOR}, which in fact leads to a scalar treatment of the
+      field (as in the previous versions), is still accepted. {\bf
+        VECTOR\_I or VECTOR\_J, i.e. vector fields, are not supported
+        anymore in OASIS3-MCT.}. See ``Support of vector fields with
+      the SCRIPR remappings'' below.
+
+    \item {\tt \$REST} is the search restriction type: {\tt LATLON} or
+      {\tt LATITUDE} (see SCRIP 1.4 documentation SCRIPusers.pdf).
+    \item {\tt \$NBIN} the number of restriction bins (see SCRIP 1.4
+      documentation SCRIPusers.pdf). Note that for D or U grid, the
+      restriction with more than 1 bin is not allowed : choose LATLON or
+      LATITUDE and \$NBIN=1
+    \item {\tt \$NV} is the number of neighbours used.
+    \item {\tt \$ASSCMP}: UNUSED; {\bf vector fields are not supported
+        anymore in OASIS3-MCT.} See ``Support of vector fields with
+      the SCRIPR remappings'' below.
+    \item {\tt \$PROJCART}: UNUSED; {\bf vector fields are not
+        supported anymore in OASIS3-MCT.} See ``Support of vector
+      fields with the SCRIPR remappings'' below.
+    \end{itemize}
+
+  \item {\tt GAUSWGT} performs a N nearest-neighbour interpolation
+    weighted by their distance and a gaussian function. All grid types
+    are supported.
+    \begin{itemize}
+
+    \item Masked target grid points: the zero value is associated to
+      masked target grid points.
+
+    \item Non-masked target grid points having some of the N source
+      nearest neighbours masked: a nearest neighbour algorithm using
+      the remaining non masked source nearest neighbours is applied.
+
+    \item Non-masked target grid points having all of the N source
+      nearest neighbours masked: by default, the nearest non-masked
+      source neighbour is used (logical {\tt ll\_nnei} hard-coded to
+      {\tt .true.} in {\tt
+        oasis3-mct/lib/scrip/src/remap\_gauswgt.F}); {\bf this is NOT
+        the same default behaviour as OASIS3.3}; to have the same
+      default behaviour as in OASIS3.3, put {\tt ll\_nnei=.false.}.
+    \end{itemize}
+
+    The configuring line is:
+  \begin{verbatim}
+ # SCRIPR (for GAUSWGT)
+     $CMETH  $CGRS  $CFTYP  $REST  $NBIN  $NV $VAR
+\end{verbatim}
+    %
+    % \vspace{-0.5cm}
+    where:
+    % $
+    all entries are as for {\tt DISTWGT}, except that:
+    \begin{itemize}
+    \item {\tt \$CMETH = GAUSWGT}
+    \item {\tt \$VAR}, which must be given as a REAL value (e.g 2.0
+      and not 2), defines the weight given to a neighbour source grid
+      point as proportional to $exp(-1/2 \cdot d^2/\sigma^2)$ where
+      $d$ is the distance between the source and target grid points,
+      and $\sigma^2 = \$VAR \cdot \overline{d}^2$ where
+      $\overline{d}^2$ is the average distance between two source grid
+      points (calculated automatically by OASIS3-MCT).
+    \end{itemize}
+
+  \item {\tt BILINEAR} performs an interpolation based on a local
+    bilinear approximation (see details in chapter 4 of SCRIP 1.4
+    documentation SCRIPusers.pdf). Logically-Rectangular (LR) and
+    Reduced (D) source grid types are supported.
+
+  \item {\tt BICUBIC} performs an interpolation based on a local
+    bicubic approximation for Logically-Rectangular (LR) grids (see
+    details in chapter 5 of SCRIP 1.4 documentation SCRIPusers.pdf),
+    and on a 16-point stencil for Gaussian Reduced (D) grids.  Note
+    that for Logically-Rectangular grids, 4 weights for each of the 4
+    enclosing source neighbours are required corresponding to the
+    field value at the point, the gradient of the field with respect
+    to {\it i}, the gradient of the field with respect to {\it j}, and
+    the cross gradient with respect to {\it i} and {\it j} in that
+    order. OASIS3-MCT will calculate the remapping weights and
+    addresses (if they are not already provided) but will not, at run
+    time, calculate the two gradients and the cross-gradient of the
+    source field (as was the case with OASIS3.3). These 3 extra fields
+    need to be calculated by the source code and transfered as extra
+    arguments of the {\tt oasis\_put} (see {\tt fld2, fld3, fld4} in
+    section \ref{prismput}).
+
+    For both {\tt BILINEAR} and {\tt BICUBIC}:
+    \begin{itemize}
+    \item Masked target grid points: the zero value is associated to
+      masked target grid points.
+
+    \item Non-masked target grid points having some of the source
+      points normally used in the bilinear or bicubic interpolation
+      masked: a N nearest neighbour algorithm using the remaining non
+      masked source points is applied.
+
+    \item Non-masked target grid points having all bilinear or bicubic
+      neighbours masked: by default, the nearest non-masked source
+      neighbour is used ({\tt ll\_nnei} hard-coded to {\tt .true.} in
+      {\tt oasis3-mct/lib/scrip/src/remap\_bilinear.f}, {\tt
+        remap\_bicubic.f} and {\tt remap\_bicubic\_reduced.f}); {\bf
+        this is not the same default behaviour as OASIS3.3}; to have
+      the same default behaviour as in OASIS3.3, put {\tt
+        ll\_nnei=.false.} in the appropriate routine.
+    \end{itemize}
+ 
+    For both {\tt BILINEAR} and {\tt BICUBIC}, the configuring line
+    is:
+
+  \begin{verbatim}
+ # SCRIPR  (for BILINEAR or BICUBIC)
+     $CMETH  $CGRS  $CFTYP  $REST  $NBIN
+\end{verbatim}
+    \vspace{-0.5cm} where:
+    % $
+    \begin{itemize}
+    \item {\tt \$CMETH = BILINEAR} or {\tt BICUBIC}
+    \item {\tt \$CGRS} is the source grid type: LR or D.
+    \item {\tt \$CFTYP}, {\tt \$NBIN} are as for {\tt DISTWGT}.
+    \item {\tt \$REST} is as for {\tt DISTWGT}, except that only {\tt
+        LATITUDE} is possible for a Reduced (D) source grid.
+    \end{itemize}
+
+  \item {\tt CONSERV} performs 1st or 2nd order conservative
+    remapping, which means that the weight of a source cell is
+    proportional to area intersected by the target cell (plus some
+    other terms proportional to the gradient of the field in the
+    longitudinal and latitudinal directions for the second order).
+
+    The configuring line is:
+  \begin{verbatim}
+ # SCRIPR (for CONSERV)
+     $CMETH  $CGRS  $CFTYP  $REST  $NBIN  $NORM  $ORDER 
+\end{verbatim}
+    % $
+    \vspace{-0.5cm} where:
+    \begin{itemize}
+    \item {\tt \$CMETH = CONSERV}
+    \item {\tt \$CGRS} is the source grid type: LR, D and U. Note that
+      the grid corners have to given by the user in the grid data file
+      {\tt grids.nc} or by the code itself in the initialisation phase
+      by calling routine {\tt oasis\_write\_corner} (see section
+      \ref{subsubsec_griddef}) ; OASIS3-MCT will not attempt to
+      automatically calculate them as OASIS3.3.
+      % For second-order remapping, only LR is supported because the
+      % gradient of the coupling field used in the transformation has
+      % to be calculated automatically by OASIS3.
+    \item {\tt \$CFTYP, \$REST}, {\tt \$NBIN} are as for {\tt
+        DISTWGT}.
+    \item {\tt \$NORM} is the NORMalization option:
+      \begin{itemize}
+      \item {\tt FRACAREA}: The sum of the non-masked source cell
+        intersected areas is used to NORMalise each target cell field
+        value: the flux is not locally conserved, but the flux value
+        itself is reasonable.
+      \item {\tt DESTAREA}: The total target cell area is used to
+        NORMalise each target cell field value even if it only partly
+        intersects non-masked source grid cells: local flux
+        conservation is ensured, but unreasonable flux values may
+        result.
+      \item {\tt FRACNNEI}: as {\tt FRACAREA}, except that at least
+        the source nearest unmasked neighbour is used for unmasked
+        target cells that intersect only masked source cells.  Note
+        that a zero value will be assigned to a target cell that does
+        not intersect any source cells (masked or unmasked), even with
+        FRACNNEI option.
+      \end{itemize}
+    \item {\tt \$ORDER}: {\tt FIRST} or {\tt SECOND} for first or
+      second order conservative remapping respectively (see SCRIP 1.4
+      documentation).
+
+      For {\tt CONSERV/SECOND}, 3 weigths are needed; OASIS3-MCT will
+      calculate these weights and corresponding addresses (if they are
+      not already provided) but will not, at run time, calculate the
+      two extra terms to which the second and third weights should be
+      applied; these terms, respectively the gradient of the field
+      with respect to the longitude ($\theta$) $\frac{\delta f}{\delta
+        \theta}$ and the gradient of the field with respect to the
+      latitude ($\phi$) $\frac{1}{cos \theta}\frac{\delta f}{\delta
+        \phi}$ need to be calculated by the source code and transfered
+      as extra arguments of the {\tt oasis\_put} (see {\tt fld2, fld3}
+      in section \ref{prismput}).  Note that {\tt CONSERV/SECOND} is
+      not positive definite and has not been fully validated yet.
+
+    \end{itemize}
+
+  \end{itemize}
+
+  {\bf Precautions related to the use of the SCRIPR/CONSERV remapping}
+
+  \begin{itemize}
+
+  \item For the 1st order conservative remapping: the weight of a
+    source cell is proportional to area of the source cell intersected
+    by target cell.  Using the divergence theorem, the SCRIP library
+    evaluates this area with the line integral along the cell borders
+    enclosing the area. As the real shape of the borders is not known
+    (only the location of the 4 corners of each cell is known), the
+    library assumes that the borders are linear in latitude and
+    longitude between two corners.  This assumption becomes less valid
+    closer to the pole and for latitudes above the {\tt north\_thresh}
+    or below the {\tt south\_thresh} values (see {\tt
+      oasis3-mct/lib/scrip/remap\_conserv.F}, the library evaluates
+    the intersection between two border segments using a Lambert
+    equivalent azimuthal projection. Problems were observed in some
+    cases for the grid cell located around this {\tt north\_thresh} or
+    {\tt south\_thresh} latitude.
+
+  \item Another limitation of the SCRIP 1st order conservative
+    remapping algorithm is that is also supposes, for line integral
+    calculation, that $sin(latitude)$ is linear in longitude on the
+    cell borders which again is in general not valid close to the
+    pole.
+    % A projection or at least a normalization by the
+    % true area of the cells (i.e. by the areas as considered by the
+    % component models) is needed.
+
+  \item For a proper consevative remapping, the corners of a cell have
+    to coincide with the corners of its neighbour cell, with no
+    ``holes'' between the cells.
+  
+  \item If two cells of one same grid overlay, at least the one with
+    the greater numerical index must be masked for a proper
+    conservative remapping.  For example, if the grid cells with {\it
+      i=1} overlays the grid cells with {\it i=imax}, the latter must
+    be masked.  If this is not the case given the mask defined in {\it
+      masks.nc}, OASIS3-MCT must be compiled with the CPP key {\tt
+      TREAT\_OVERLAY} which will ensure that these rules are
+    respected. This CPP key was introduced in OASIS3.3.
+      
+  \item A target grid cell intersecting no source cell (either masked
+    or non masked) at all i.e. falling in a ``hole'' of the source
+    grid will in all cases get a zero value.
+    
+  \item If a target grid cell intersects only masked source cells, it
+    will still get a zero value unless the {\tt FRACNNEI}
+    normalisation option is used, in which case it will get the
+    nearest non masked neighbour value. {\bf Note that the option of
+      having the value 1.0E+20 assigned to these target grid cell
+      intersecting only masked source cells (for easier
+      identification) is not yet availble in OASIS3-MCT.}
+   
+
+    % The target grid mask is never considered in {\tt CONSERV},
+    % except with normalisation option {\tt FRACNNEI} (see below). To
+    % have a value calculated, a target grid cell must intersect at
+    % least one source cell. However, the NORMlisation option (that
+    % takes into account the source grid mask, see below) may result
+    % in a null value calculated for those target grid cells. In that
+    % case (i.e.  at least one intersecting source cell, but a null
+    % value finally calculated because of the normalisation option),
+    % the value 1.0E+20 is assigned to those target grid points if
+    % {\tt prism/src/lib/scrip/src/scriprmp.f} or {\tt vector.F90}
+    % (for vector interpolation) are compiled with {\tt
+    %   ll\_weightot=.true.}.
+    
+   
+  \end{itemize}
+
+  % {\bf Precautions related to the use of all SCRIPR remappings}
+
+  % \begin{itemize}
+
+  % \item For using {\tt SCRIPR} interpolations, linking with the
+  %   NetCDF library is mandatory and the grid data files (see section
+  %   \ref{subsec_griddata}) must be NetCDF files (binary files are
+  %   not supported).
+
+
+
+  %   the weights and addresses will also differ whether or not the
+  %   {\tt MASK} and {\tt EXTRAP} transformations are first activated
+  %   during the pre-processing phase (see section
+  %   \ref{subsec_preproc}) and this option is not stored in the
+  %   remapping file name. Therefore, the remapping file used will be
+  %   the one created for the first field having the same source grid,
+  %   target grid, and interpolation type (and the same normalization
+  %   option for {\tt CONSERV}), even if the {\tt MASK} and {\tt
+  %     EXTRAP} transformations are used or not for that field.  (This
+  %   inconsistency is however usually not a problem as the {\tt MASK}
+  %   and {\tt EXTRAP} transformations are usually used for all fields
+  %   having the same source grid, target grid, and interpolation
+  %   type, or not at all.)
+  % \end{itemize}
+
+  {\bf Support of vector fields with the SCRIPR remappings}
+
+  Vector mapping is NOT supported and will not be supported by
+  OASIS3-MCT. For proper treatment of vector fields, the component
+  model has to send the 3 components of the vector projected in a
+  Cartesian coordinate system.
+
+\item {\bf INTERP}: UNUSED
+
+\item {\bf MOZAIC}: UNUSED; note that {\tt MAPPING} (see above) is the
+  NetCDF equivalent to {\tt MOZAIC}.
+
+\item {\bf NOINTERP}: UNUSED
+
+\item {\bf FILLING}: UNUSED
+
+\end{itemize}
+
+\section{The post-processing stage}
+\label{subsec_cooking}
+
+\begin{itemize}
+
+\item {\bf CONSERV}:
+
+  {\tt CONSERV} ensures a global modification of the coupling field.
+  This analysis requires the source and target grid mesh areas to be
+  transfered to the coupler with {\tt oasis\_write\_area} (see section
+  \ref{subsubsec_griddef}). {\bf For a correct CONSERV operation,
+    overlapping grid cells on the source grid or on the target grid
+    must be masked.} In the {\it namcouple}, {\tt CONSERV} requires
+  one input line with one argument and one optional argument:
+
+ \begin{verbatim}
+# CONSERV operation
+     $CMETH  $CONSOPT
+\end{verbatim}
+  \vspace{-0.5cm} where:
+  \begin{itemize}
+  \item {\tt \$CMETH} is the method desired with the following choices
+    \begin{itemize}
+    \item with {\tt \$CMETH = GLOBAL}, the field is integrated on both
+      source and target grids, without considering values of masked
+      points, and the residual (target - source) is uniformly
+      distributed on the target grid; this option ensures global
+      conservation of the field
+    \item with {\tt \$CMETH = GLBPOS}, the same operation is performed
+      except that the residual is distributed proportionally to the
+      value of the original field; this option ensures the global
+      conservation of the field and does not change the sign of the
+      field
+    \item with {\tt \$CMETH = BASBAL}, the operation is analogous to
+      {\tt GLOBAL} except that the non masked surface of the source
+      and the target grids are taken into account in the calculation
+      of the residual; this option does not ensure global conservation
+      of the field but ensures that the energy received is
+      proportional to the non masked surface of the target grid
+    \item with {\tt \$CMETH = BASPOS}, the non masked surface of the
+      source and the target grids are taken into account and the
+      residual is distributed proportionally to the value of the
+      original field; therefore, this option does not ensure global
+      conservation of the field but ensures that the energy received
+      is proportional to the non masked surface of the target grid and
+      it does not change the sign of the field.
+    \end{itemize}
+  \item {\tt \$CONSOPT} is an optional argument specifying the
+    algorithm.  {\tt \$CONSOPT} can be {\tt bfb} or {\tt opt}.  The
+    {\tt bfb} option enforces a bit-for-bit transformation regardless
+    of the grid decomposition or process count.  The {\tt opt} option
+    carries out the conservation using an optimal algorithm using less
+    memory and a faster approach. Option {\tt bfb} is the default
+    setting.
+  \end{itemize}
+
+
+
+\item {\bf SUBGRID}: UNUSED
+
+  % {\tt SUBGRID} can be used to interpolate a field from a coarse
+  % grid to a finer target grid (the target grid must be finer over
+  % the whole domain). Two types of subgrid interpolation can be
+  % performed, depending on the type of the field.
+%
+  % For solar type of flux field ({\tt \$SUBTYPE = SOLAR}), the
+  % operation performed is:
+%$$\Phi_{i} = \frac{1-\alpha_i}{1-\alpha} F$$ where $\Phi_{i}$ ($F$) is
+%the flux on the fine (coarse) grid, $\alpha_i$ ($\alpha$) an
+% auxiliary field on the fine (coarse) grid (e.g. the albedo).  The
+% whole operation is interpolated from the coarse grid with a
+% grid-mapping type of interpolation; the dataset of weights and
+% addresses has to be given by the user.
+%
+% For non-solar type of field ({\tt \$SUBTYPE = NONSOLAR}), a
+% first-order Taylor expansion of the field on the fine grid
+% relatively to a state variable is performed (for instance, an
+% expansion of the total heat flux relatively to the SST):
+%$$\Phi_{i} = F + \frac{\partial F}{\partial T} ( T_i - T ) $$ where
+%$\Phi_{i}$ ($F$) is the heat flux on the fine (coarse) grid, $T_i$
+% ($T$) an auxiliary field on the fine (coarse) grid (e.g. the SST)
+% and $\frac{\partial F}{\partial T}$ the derivative of the flux
+% versus the auxiliary field on the coarse grid. This operation is
+% interpolated from the coarse grid with a grid-mapping type of
+% interpolation; the dataset of weights and addresses has to be given
+% by the user.
+%
+% This analysis requires one input line with 7 or 8 arguments
+% depending on the type of subgrid interpolation.
+%
+% \begin{enumerate}
+% \item If the the {\tt SUBGRID} operation is performed on a solar
+%   flux, the 7-argument input line is:
+%\begin{verbatim}
+%# SUBGRID operation with $SUBTYPE=SOLAR 
+%  $CFILE  $NUMLU  $NID  $NV  $SUBTYPE  $CCOARSE $CFINE\end{verbatim}where
+%{\tt \$CFILE} and {\tt \$NUMLU} are the subgrid-mapping file name and
+%associated logical unit (see section \ref{subsec_transformationdata} for the
+%structure of this file); {\tt \$NID} the identificator for this
+%subgrid-mapping dataset within the file build by OASIS based on all
+%the different {\tt SUBGRID} analyses in the present coupling; {\tt
+%\$NV} is the maximum number of target grid points use in the
+%subgrid-mapping; {\tt \$SUBTYPE = SOLAR} is the type of subgrid
+%  interpolation; {\tt \$CCOARSE} is the
+%auxiliary field name on the coarse grid (corresponding to $\alpha$)
+%and {\tt \$CFINE} is the auxiliary field name on fine grid
+%(corresponding to $\alpha_i$).
+%These two fields needs to be exchanged between their original model
+%and OASIS3 main process, at least as {\tt AUXILARY} fields.
+%This analysis is performed from the coarse grid with a grid-mapping type
+%of interpolation based on the {\tt \$CFILE} file.
+%
+% \item If the the SUBGRID operation is performed on a nonsolar flux,
+%   the 8-argument input line is:
+%\begin{verbatim}
+%# SUBGRID operation with $SUBTYPE=NONSOLAR
+%  $CFILE $NUMLU $NID $NV $SUBTYPE $CCOARSE $CFINE $CDQDT
+%\end{verbatim} where {\tt \$CFILE},  {\tt \$NUMLU},  {\tt \$NID},  
+%{\tt \$NV} are as for a solar subgrid interpolation; {\tt
+%\$SUBTYPE = NONSOLAR}; {\tt \$CCOARSE} is the auxiliary
+%field name on the coarse grid (corresponding to $T$) and {\tt \$CFINE}
+%is the auxiliary field name on fine grid (corresponding to $T_i$); the
+%additional argument {\tt \$CDQDT} is the coupling ratio on the coarse
+%grid (corresponding to $\frac{\partial F}{\partial T}$) These three
+%fields need to be exchanged between their original model and OASIS3
+%main process as {\tt AUXILARY} fields. This operation is performed from the
+%coarse grid with a grid-mapping type of interpolation based on the {\tt
+%\$CFILE} file.
+%
+% \end{enumerate}
+
+\item {\bf BLASNEW}:
+ 
+  {\tt BLASNEW} performs a scalar multiply or scalar add to any
+  destination field.  This is the equivalent of BLASOLD on the
+  destination side.  The prior feature that supported linear
+  combinations of the current coupling field with any other fields
+  after the interpolation has been deprecated.
+
+  This analysis requires the same input line(s) as {\tt BLASOLD}.
+
+\item {\bf MASKP}: UNUSED
+
+\item {\bf REVERSE}: UNUSED
+
+\item {\bf CHECKOUT}:
+
+  {\tt CHECKOUT} calculates the global minimum, the maximum and the
+  sum of the target field values (not weighted by the grid cell area)
+  and prints them to the OASIS3-MCT debug file (for the master process
+  of the target component model only). These informations are found in 
+  the debug file of the master process of the target model under the 
+  attribute ``diags''. This operation does not
+  transform the field.  The generic input line is as for {\tt CHECKIN}
+  (see above).
+
+\item {\bf GLORED}: UNUSED
+
+\end{itemize}
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG5_Auxiliary_files.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG5_Auxiliary_files.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG5_Auxiliary_files.tex	(revision 4775)
@@ -0,0 +1,201 @@
+\newpage
+\chapter{OASIS3-MCT auxiliary data files}
+\label{sec_auxiliary}
+
+In some cases, OASIS3-MCT uses auxiliary data files, e.g. defining the
+grids of the models being coupled, containing the field coupling
+restart values or input data values, or the remapping weights and
+addresses.
+
+\section{Grid data files}
+\label{subsec_griddata}
+
+With OASIS3-MCT, the grid data files {\em grids.nc, masks.nc} and {\em
+  areas.nc} are required only for certain operations, i.e.  {\em
+  grids.nc}, and {\em masks.nc} for {\tt SCRIPR} (see section
+\ref{subsec_interp}) and {\em masks.nc} and {\em areas.nc} for {\tt
+  CONSERV} (see section \ref{subsec_cooking}). These NetCDF files can
+be created by the user before the run or can be written directly at
+run time by the master process of each component model using the grid
+data definition routines (see section \ref{subsubsec_griddef}).  These
+routines can be used by the component models to add grid fields to the
+grid files but grid fields are {\bf never} overwritten in the grid
+files.
+
+The arrays containing the grid information are dimensioned {\tt (nx,
+  ny)}, where {\tt nx} and {\tt ny} are the grid first and second
+dimension.  Unstructured grids or other grids expressed with 1D
+vectors are supported by setting {\tt nx} to the total number of grid
+points and {\tt ny} to 1.
+
+\begin{enumerate}
+
+\item {\em grids.nc}: contains the model grid longitudes and latitudes
+  in double precision {\tt REAL} arrays. The array names must be
+  composed of a prefix (4 characters), given by the user in the {\it
+    namcouple} on the second line of each field (see section
+  \ref{subsec_namcouplesecond}), and of a suffix (4 characters); this
+  suffix is ``.lon'' or ``.lat'' for respectively the grid point
+  longitudes or latitudes.
+
+  If the {\tt SCRIPR/CONSERV} remapping is used, longitudes and
+  latitudes for the source and target grid {\bf corners} must also be
+  available in the {\em grids.nc} file as double precision {\tt
+    REAL} arrays dimensioned {\tt (nx,ny,4)} or {\tt (nbr\_pts,1,4)}
+  where {\tt 4} is the number of corners (in the counterclockwize
+  sense). The names of the arrays must be composed of the grid prefix
+  and the suffix ``.clo'' or ``.cla'' for respectively the grid corner
+  longitudes or latitudes.  As for the other grid information, the
+  corners can be provided in {\em grids.nc} before the run by the user
+  or directly by the model through specific calls (see section
+  \ref{subsubsec_griddef}).
+
+  % For source grids of Logically Rectangular LR type only, the grid
+  % corners will however be automatically calculated and stored by
+  % OASIS if they are not initially available in {\em
+  %   grids.nc}\footnote{Tip: to automatically calculate the corners
+  %   of a Logically Rectangular LR target grid, use the corresponding
+  %   reverse remapping in which the current target grid becomes the
+  %   source grid.}.
+ 
+  Longitudes must be given in degrees East in the interval -360.0 to
+  720.0. Latitudes must be given in degrees North in the interval
+  -90.0 to 90.0. Note that if some grid points overlap, it is
+  recommended to define those points with the same number (e.g. 360.0
+  for both, not 450.0 for one and 90.0 for the other) to ensure
+  automatic detection of overlap by OASIS3-MCT.
+ 
+  The corners of a cell cannot be defined modulo 360 degrees. For
+  example, a cell located over Greenwich will have to be defined with
+  corners at -1.0 deg and 1.0 deg but not with corners at 359.0 deg
+  and 1.0 deg.
+ 
+  Cells larger than 180.0 degrees in longitude are not supported.
+ 
+\item {\em masks.nc}: contains the masks for all component model grids
+  in {\tt INTEGER} arrays. {\bf Be careful to note the historical
+    OASIS convention: 0 -not masked i.e.  active- or 1 -masked
+    i.e. not active- for each grid point}. The array names must be
+  composed of the grid prefix and the suffix ``.msk''. This file, {\em
+    masks} or {\em masks.nc}, is mandatory.
+
+\item {\em areas.nc}: this file contains mesh surfaces for the
+  component model grids in double precision {\tt REAL} arrays. The
+  array names must be composed of the grid prefix and the suffix
+  ``.srf''.  The surfaces may be given in any units but they must be
+  all the same. This file {\em areas.nc} is mandatory for {\tt
+    CONSERV/GLOBAL},{\tt /GLBPOS}, {\tt /BASBAL}, and {\tt /BASPOS};
+  it is not required otherwise.
+
+\end{enumerate}
+
+\section{Coupling restart files}
+\label{subsec_restartdata}
+
+At the beginning of a coupled run, some coupling fields may have to be
+initially read from their coupling restart file on their source grid
+(see the LAG concept in section \ref{subsubsec_Algoritms}). When
+needed, these files are also automatically updated by the last active
+{\tt oasis\_put} or {\tt prism\_put\_proto} call of the run (see
+section \ref{prismput}) .
+% To force the writing of the field in its coupling restart file, one
+% can use the routine {\tt prism\_put\_restart\_proto} (see section
+% \ref{subsec:auxiliary}).
+{\bf Warning}: the date is not written or read to/from the restart
+file; therefore, the user has to make sure that the appropriate
+coupling restart file is present in the working directory. The
+coupling restart files must follow the NetCDF format.
+
+% Note that all restart files have to be present in the working
+% directory at the %beginning of the
+% run even if one model is delayed with respect to the others.
+
+The name of the coupling restart file is given by the 6th character
+string on the first configuring line for each field in the {\it
+  namcouple} (see section \ref{subsec_namcouplesecond}). Coupling
+fields coming from different models cannot be in the same coupling
+restart files, but for each model, there can be an arbitrary number of
+fields written in one coupling restart file. The only exception is when a coupling field sent by a source component model is associated with more than one target field and model; in that case, if coupling restart files are required, it is mandatory to specify different files for the different fields. 
+
+In the coupling restart files, the fields must be provided on the
+source grid in single or double precision REAL arrays and, as the grid
+data files, must be dimensioned {\tt (nx, ny)}, where {\tt nx} and
+{\tt ny} are the grid first and second dimension (see section
+\ref{subsec_griddata} above).  The shape and orientation of each
+restart field (and of the corresponding coupling fields exchanged
+during the simulation) must be coherent with the shape of its grid
+data arrays.
+
+The coupling restart files are also used automatically by OASIS3-MCT
+to allow partial LOCTRANS time transformation to be saved at the end
+of a run for exact restart at the start of the next run. For that
+reason, coupling restart filenames are now required for all {\it
+  namcouple} transformations that use LOCTRANS (with non INSTANT
+values).
+
+\section{Input data files}
+\label{subsec_inputdata}
+
+Fields with status {\tt INPUT} in the {\it namcouple} will, at
+runtime, simply be read in from a NetCDF input file by the target
+model below the {\tt oasis\_get} call, at appropriate times
+corresponding to the input period indicated by the user in the {\it
+  namcouple}.
+
+The name of the file must be the one given on the field first
+configuring line in the {\it namcouple} (see section
+\ref{subsubsec_secondINPUT}). There must be one input file per {\tt
+  INPUT} field, containing a time sequence of the field in a single or
+double precision REAL array named with the field symbolic name in the
+{\it namcouple} and dimensioned {\tt (nx,ny,time)}.  The time variable
+has to be an array {\tt time(time)} expressed in ``seconds since
+beginning of run''. The ``time'' dimension has to be the unlimited
+dimension.
+% For a practical example, see the file SOALBEDO.nc in {\tt
+%   oasis3/examples/toyoasis3/data}.
+
+% subsection{Input data files}
+
+\section{Transformation auxiliary data files}
+\label{subsec_mapdata}
+
+The mapping files to be used for the MAPPING option must be consistent
+with the files generated by the SCRIP library to be used for the {\tt
+  SCRIPR} transformations (see also section \ref{subsec_interp}). The
+files are NetCDF containing the following fields:
+\begin{verbatim}
+dimensions:
+      src_grid_size = xxx ;
+      dst_grid_size = xxx ;
+      num_links = xxx ;
+      num_wgts = xxx ;
+variables:
+      int src_address(num_links) 
+      int dst_address(num_links) 
+      double remap_matrix(num_links, num_wgts) 
+\end{verbatim}
+where
+\begin{itemize}
+\item {\tt src\_grid\_size} is a scalar integer indicating the total number
+  of points in the source grid.  This is typically a large number.  
+  This field is a netCDF dimension.
+\item {\tt dst\_grid\_size} is a scalar integer indicating the total number
+  of points in the target grid.  This is typically a large number.  
+  This field is a netCDF dimension.
+\item {\tt num\_links} is a scalar integer indicating the total number
+  of associated grid point pairs in the file.  This is typically a
+  large number.  This field is a netCDF dimension.
+\item {\tt num\_wgts} is a scalar integer indicating the number of
+  weights per associated grid point pair (up to 5 are supported, see
+  section \ref{prismput}).  This field is a netCDF dimension.
+\item {\tt src\_address} is a one dimensional array of size {\tt
+    num\_links}.  It contains the integer source address associated
+  with each weight.  This field is a netCDF variable.
+\item {\tt dst\_address} is a one dimensional array of size {\tt
+    num\_links}.  It contains the integer destination address
+  associated with each weight.  This field is a netCDF variable.
+\item {\tt remap\_matrix} is a two dimensional array of size {\tt
+    (num\_links, num\_wgts)}.  It contains the real weight value(s)
+  associated with the source and destination address.  This field is a
+  netCDF variable.
+\end{itemize}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG6_Compilation_running.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG6_Compilation_running.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG6_Compilation_running.tex	(revision 4775)
@@ -0,0 +1,207 @@
+\newpage
+%
+
+\chapter{Compiling, running and debugging}
+\label{sec_compilationrunning}
+
+\section{Compiling OASIS3-MCT}
+\label{subsec_compile}
+
+Compiling OASIS3-MCT libraries can be done in directory {\tt
+  oasis3-MCT/util/make\_dir} with Makefile \\ {\tt TopMakefileOasis3}
+which must be completed with a header file {\tt make.{\it
+    your\_platform}} specific to the compiling platform used and
+specified in {\tt oasis3-MCT/util/make\_dir/make.inc}.  One of the
+header files distributed with the release can by used as a template.
+The root of the OASIS3-MCT tree can be anywhere and must be set in the
+variable {\tt COUPLE} in the {\tt make.{\it your\_platform}} file.
+
+The coupled models must be compiled with the same library as the one 
+used to compile OASIS3-MCT.
+
+The following commands are available:
+
+\begin{itemize}
+\item {\tt make -f TopMakefileOasis3} or {\tt make oasis3\_psmile -f
+    TopMakefileOasis3} (for backward compatibility):
+
+  compiles all OASIS3-MCT libraries {\it mct}, {\it scrip} and {\it
+    psmile};
+
+\item {\tt make realclean -f TopMakefileOasis3}:
+
+  removes all OASIS3-MCT compiled sources and librairies.
+
+\end{itemize}
+
+Log and error messages from compilation are saved in {\tt /util/make\_dir} in the files
+{\tt COMP.log} and {\tt COMP.err} .
+
+During compilation, a new compiling directory, defined by variable
+{\tt ARCHDIR} is created.  After successful compilation, resulting
+libraries are found in the compiling directory in {\tt /lib} and
+object and module files in {\tt /build}. 
+
+If module {\tt mod\_oasis} is used in the
+models, it is enough to include the path of the psmile objects and
+modules ({\tt \$ARCHDIR/build/lib/psmile.MPI1}) for the compilation and to use the psmile library {\tt \$ARCHDIR/lib/libpsmile.MPI1.a} when
+linking. If module {\tt mod\_prism} is used in the models, it is necessary to
+include the path of the psmile and of the mct objects and modules for
+the compilation (i.e. {\tt \$ARCHDIR/build/lib/psmile.MPI1} and {\tt /mct} and to use both the psmile and mct libraries {\tt \$ARCHDIR/lib/libpsmile.MPI1.a} and {\tt libmct.a} and {\tt libmpeu.a} when linking.
+
+Exchange of coupling fields in single and double precision is now supported directly through the interface 
+(see section \ref{subsubsec_Declaration}), even if all real variables are now treated in double precision internally.
+For double precision coupling field, there is no need anymore to promote REAL variables to double precision at compilation.
+
+\section{CPP keys}
+\label{subsec_cpp}
+
+The following CPP keys are coded in OASIS3-MCT and can be specified in
+{\tt CPPDEF} in {\tt make.{\it your\_platform}} file.
+
+\begin{itemize}
+
+\item {\tt TREAT\_OVERLAY}: To ensure, in {\tt SCRIPR/CONSERV}
+  remapping (see section \ref{subsec_interp}), that if two cells of
+  the source grid overlay, at least the one with the greater numerical
+  index is masked (they also can be both masked); this is mandatory
+  for this remapping. For example, if the grid line with {\it i=1} overlaps
+  the grid line with {\it i=imax}, it is the latter that must be masked;
+  when this is not the case with the mask defined in {\it masks.nc},
+  this CPP key forces these rules to be respected.
+
+\item {\tt balance}: Add a MPI\_Wtime() function before and after
+  mct\_isend (MPI put) and mct\_recv (MPI get) to calculate the time
+  of the send and receive of a coupling field. This option can be used
+  to produce timestamps in OASIS3-MCT debug files. During a post-processing
+  phase, this information can be used to perform an analysis of the
+  coupled components load (un)balance; specific tools have been
+  developed to do this and will be released with a further version of
+  OASIS3-MCT. {\bf This option is temporarily not recommended as it was observed that
+  it was increasing the simulation time of coupled models on
+  the PRACE computer MareNostrum.}
+
+\end{itemize}
+
+\section{Running OASIS3-MCT}
+\label{subsec_running}
+
+Examples of running environement are provided with the sources. For
+more details, see the instructions on OASIS web site at
+{\tt https://verc.enes.org/oasis/oasis-dedicated-user-support-1/} {\tt user-toys/tutorial-and-test\_interpolation-of-oasis3-mct-1}.
+.
+
+\subsection{The tutorial toy model}
+\label{subsec_tutorial}
+
+A practical example on how to run OASIS3-MCT and running it in a
+coupled system is provided in {\tt oasis3-mct/examples/tutorial}. See also the document {\tt tutorial\_oasis3-mct.pdf} there in for
+more details,
+
+\subsection{The test\_interpolation environment}
+\label{subsec_testinterpolation}
+
+This environment available with the sources in {\tt
+  oasis3-mct/examples/test\_interpolation} allows the user to test the
+quality of the interpolations and transformations between his source
+and target grids by calculating the error of interpolation on the
+target grid. For more details, see also the document {\tt test\_interpolation\_oasis3-mct.pdf} there in.
+
+\section{Debugging}
+\label{subsec_debug}
+
+\subsection{Debug files}
+If you experience problems while running your coupled model with
+OASIS3-MCT, you can obtain more information on what is happening by
+increasing the {\tt \$NLOGPRT} value in your {\it namcouple} (see also section
+\ref{subsec_namcouplefirst}).
+
+Different outputs are written depending on {\tt \$NLOGPRT} value:
+\begin{itemize}
+\item {0} : one file debug.root.xx is open by the master process of
+  each model and one file debug\_notroot.xx is open for all the other
+  processes of each model to write only error information if an error
+  occurs.
+\item {1} : one file debug.root.xx is open by the master process of
+  each model to write information equivalent to level 10 (see below);
+  one file debug\_notroot.xx is open for all the other processes of
+  each model to write only error information if an error occurs.
+\item {2} : one file debug.xx.xxxxxx is open by each process of each
+  model to write normal production diagnostics.
+\item {5} : as for 2 with in addition some initial debug info.
+\item {10} : as for 5 with in addition the routine calling tree.
+\item {12} : as for 10 with in addition some routine calling notes.
+\item {15} : as for 12 with even more debug diagnostics.
+\item {20} : as for 15 with in addition some extra runtime analysis.
+\item {30} : full debug information.
+\end{itemize}
+
+\subsection{Time statistics files}
+\label{timestat}
+
+The variable TIMER\_Debug, defined in the {\it namcouple} (second
+number on the line below \$NLOGPRT keyword), is used to obtain time
+statistics over all the processors for each routine.
+
+Different output are written (in files named {\tt *.timers\_xxxx})
+depending on TIMER\_Debug value :
+
+\begin{itemize}
+\item {TIMER\_Debug=0} : nothing is calculated, nothing is written.
+\item {TIMER\_Debug=1} : the times are calculated and written in a
+  single file by the process 0 as well as the min and the max times
+  over all the processes.
+\item {TIMER\_Debug=2} : the times are calculated and each process
+  writes its own file ; process 0 also writes the min and the max
+  times over all the processes in its file.
+\item {TIMER\_Debug=3} : the times are calculated and each process
+  writes its own file ; process 0 also writes in its file the min
+  and the max times over all processes and also writes in its file
+  all the results for each process.
+\end{itemize}
+
+The time given for each timer is calculated by the difference between
+calls to {\tt oasis\_timer\_start()} and {\tt oasis\_timer\_stop()}
+and is the accumulated time over the entire run. Here is an overview
+of the meaning of the different timers as implemented by default.
+
+\begin{itemize}
+\item {'total after init'} : total time of the simulation, implemented
+  in {\tt mod\_oasis\_method}, i.e. between the end of {\tt
+    oasis\_init\_comp} and the call to {\tt mpi\_barrier} and {\tt
+    mpi\_finalize} in routine {\tt oasis\_terminate}.
+\item {'map definition'} : time spent in {\tt mct\_gsmap\_init} in
+  routine {\tt oasis\_def\_partition}; this routine defines the
+  patterns of communication between the source and target processes.
+\item {'cpl\_setup'} :time spent in {\tt oasis\_coupler\_setup}, which
+  sets up additional coupling aspects related to {\tt
+    oasis\_method\_enddef}.
+\item {'cpl\_smatrd'} : time spent in {\tt
+    oasis\_coupler\_smatreaddnc} in {\tt mod\_oasis\_coupler} (routine
+  {\tt oasis\_coupler\_setup}); this routine performs a distributed
+  read of a NetCDF SCRIP file and returns weights in a distributed
+  SparseMatrix, and calls {\tt mct\_sMatP\_Init} which initialises the
+  sparse matrix vector multiplication.
+\item {'oasis\_advance\_init()'} : time spent in {\tt
+    oasis\_advance\_init}, which handles reading of initial coupling
+  restart and communication of data for fields with positive lags.
+\item {'grcv\_00x'} : time spent in the reception of field x in {\tt
+    mct\_recv} (including communication and possible waiting time
+  linked to unbalance of components).
+\item {'wout\_00x'} : time spent in the I/O for field x in routine
+  {\tt oasis\_advance\_run}.
+\item {'gcpy\_00x'} : time spent in routine {\tt oasis\_advance\_run}
+  in copying the field x just received in a local array.
+\item {'pcpy\_00x'} : time spent in routine {\tt oasis\_advance\_run}
+  in copying the local field x in the array to send (i.e. with local
+  transformation besides division for averaging).
+\item {'pavg\_00x'} : time spent in routine {\tt oasis\_advance\_run}
+  to calculate the average of field x (if done).
+\item {'pmap\_00x'/'gmap\_00x'} : time spent in routine {\tt
+    oasis\_advance\_run} for the matrix vector multiplication for
+  field x on the source/target processes.
+\item {'psnd\_00x'} : time spent in routine {\tt oasis\_advance\_run}
+  for sending field x (i.e. including call to {\tt mct\_waitsend} and
+  {\tt mct\_isend}).
+\end{itemize}
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA1_Grid_description.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA1_Grid_description.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA1_Grid_description.tex	(revision 4775)
@@ -0,0 +1,37 @@
+\newpage
+\appendix
+\chapter{The grid types for the transformations}
+\label{subsec_gridtypes}
+
+As described in section \ref{sec_transformations} for the different
+SCRIP remappings, OASIS3-MCT support different types of grids. The
+characteristics of these grids are detailed here:
+
+\begin{itemize}
+
+\item {\tt `LR' grid}: The longitudes and the latitudes of
+  2D Logically-Rectangular (LR) grid points can be described by two arrays
+  {\tt longitude(i,j)} and {\tt latitude(i,j)}, where i and j
+  are respectively the first and second index dimensions. Streched
+  or/and rotated grids are LR grids. Note that previous OASIS3 A, B, G, L, Y, or Z
+  grids are all particular cases of LR grids.
+
+\item {\tt `U' grid}: Unstructured (U) grids do have any particular
+      structure. The longitudes and the latitudes of 2D Unstructured
+      grid points must be described by two arrays {\tt
+      longitude(nbr\_pts,1)} and {\tt latitude(nbr\_pts,1)}, where nbr\_pts
+      is the total grid size.
+
+\item {\tt `D' grid} The Reduced (D) grid is composed of a certain
+number of latitude circles, each one being divided into a varying
+number of longitudinal segments. In OASIS3-MCT, the grid data (longitudes,
+latitudes, etc.) must be described by arrays dimensioned {\tt
+(nbr\_pts,1)}, where {\tt nbr\_pts} is the total number of grid
+points. There is no overlap of the grid, and no grid point at the
+equator nor at the poles. There are grid points on the Greenwich
+meridian.
+ 
+\end{itemize}
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA2_SCRIP.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA2_SCRIP.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA2_SCRIP.tex	(revision 4775)
@@ -0,0 +1,57 @@
+\newpage
+
+\chapter{Copyright statements}
+
+\section{OASIS3 copyright statement}
+
+Copyright © 2010 Centre Europeen de Recherche et Formation
+Avancee en Calcul Scientifique (CERFACS).  
+
+This software and ancillary information called OASIS3 is free
+software.  CERFACS has rights to use, reproduce, and distribute
+OASIS3. The public may copy, distribute, use, prepare derivative works and
+publicly display OASIS3 under the terms of the Lesser GNU General
+Public License (LGPL) as published by the Free Software Foundation,
+provided that this notice and any statement of authorship are
+reproduced on all copies. If OASIS3 is modified to produce derivative
+works, such modified software should be clearly marked, so as not to
+confuse it with the OASIS3 version available from CERFACS.
+
+The developers of the OASIS3 software are researchers attempting to
+build a modular and user-friendly coupler accessible to the climate
+modelling community. Although we use the tool ourselves and have made
+every effort to ensure its accuracy, we can not make any
+guarantees. We provide the software to you for free. In return,
+you--the user--assume full responsibility for use of the software. The
+OASIS3 software comes without any warranties (implied or expressed) and
+is not guaranteed to work for you or on your computer. Specifically,
+CERFACS and the various individuals involved in development and
+maintenance of the OASIS3 software are not responsible for any damage
+that may result from correct or incorrect use of this software.
+
+\section{The SCRIP 1.4 copyright statement}
+\label{sec_SCRIP}
+
+The SCRIP 1.4 copyright statement reads as follows:
+
+ ``Copyright © 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 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.''
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA3_couplings.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA3_couplings.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA3_couplings.tex	(revision 4775)
@@ -0,0 +1,145 @@
+\newpage
+
+\chapter{Coupled models realized with OASIS}
+\label{sec_couplings}
+
+\small
+\begin{center}
+\begin{longtable}{|l|l|l|}
+\caption[Use of OASIS3: centres, coupled models and
+  computing platforms]{Use of OASIS3: centres, coupled models and
+  computing platforms} \label{Tab:OASIS3_a}\\
+
+\hline \multicolumn{1}{|c|}{\textbf{Centre}} &
+\multicolumn{1}{c|}{\textbf{Coupled model}} & \multicolumn{1}{c|}{\textbf{Platform}} \\ \hline 
+\endfirsthead
+
+\multicolumn{3}{c}%
+{{\bfseries \tablename\ \thetable{} -- continued from previous page}} \\
+\hline \multicolumn{1}{|c|}{\textbf{Centre}} &
+\multicolumn{1}{c|}{\textbf{Coupled model}} &
+\multicolumn{1}{c|}{\textbf{Platform}} \\ \hline 
+\endhead
+
+\hline \multicolumn{3}{|r|}{{Continued on next page}} \\ \hline
+\endfoot
+
+\hline \hline
+\endlastfoot
+
+CERFACS (FR) &	ARPEGE4\_T63/NEMO-ORCA2-LIM/TRIP &	Linux Cluster, CRAY XD1,\\
+&    &    VPP5000, NEC SX6-SX8 \\
+CERFACS (FR) & 	ARPEGE\_T63/NEMIX-ORCA2 &		CRAY XD1 \\
+CERFACS (FR) & 	ARPEGE\_T359/NEMO-ORCA012  &			NEC SX9 \\
+CERFACS (FR) & 	ARPEGE\_T799/NEMIX-ORCA025 &			Bullx, Altix ICE \\
+M\'et\'eo-France (FR) &	ARPEGE\_V4.6/NEMO-ORCA2/NEMOmed8  &	NEC-SX8 \\
+M\'et\'eo-France (FR) &	ALADIN-Climat/NEMOmed8/TRIP &		NEC-SX9 \\
+M\'et\'eo-France (FR) &	ARPEGE\_V5/NEMOV3-ORCA1/TRIP &          NEC-SX9 \\
+M\'et\'eo-France (FR) &	ARPEGE\_V5.1/NEMO1 &                    IBM Power 6 \\
+IPSL (FR) &	LMDZ/NEMO-ORCA2/ - & \\
+          &     LMDZmed/NEMOmed8   & \\
+IPSL (FR) &	LMDz(144x142)/NEMO-ORCA2	 & NEC SX8 \\
+OMP (FR) &	MESO-NH/SYMPHONIE &				Linux Opteron cluster \\
+LGGE (FR) &	MAR/NEMO-LIM & \\
+ECMWF & 	IFS\_T399/NEMO-ORCA1 	 &	IBM Power 6 \\
+MPI-M (DE) &	ECHAM5/MPIOM  &               IBM Power 6, SUN Linux \\
+MPI-M (DE) &	REMO/MPIOM &			IBM Power 575 \\
+Met Office (UK) & 	UM Atm(192x145)/NEMO-ORCA1 &			IBM Power6, NEC SX6 \\
+Met Office (UK) &  UM Atm(432x325/NEMO-ORCA025 &	IBM Power6 \\		
+NCAS/Reading (UK) & ECHAM4/NEMO-ORCA2 &	NEC SX6-SX8 \\
+NCAS/Reading (UK) & HadAM3/NEMO-ORCA2 &	NEC SX8 \\
+IFM-GEOMAR (DE) & ECHAM5\_T63/NEMO-ORCA2 &	NEC SX6, SX8, SX9 \\	
+CMCC (IT) &	ECHAM5\_T31L31/OPA8.2-ORCA2 &	NEC SX9 \\
+CMCC (IT) &	ECHAM5\_T159L31/OPA8.2-ORCA2  &   IBM Power6 \\
+CMCC (IT) &	ECHAM5\_T63L95/OPA8.2-ORCA2 &   \\   
+CMCC (IT) &	ECHAM5\_T159/OPA8.2-ORCA2/ - & \\
+          &     NEMOMed\_1/16                & \\   
+ENEA (IT) &	RegCM/MITgcm	 &				IBM-SP5 \\
+LMNCP (IT) &	WRF/ROMS & \\
+SMHI (SE) &	EC-Earth: IFS\_T159/NEMO-ORCA1 &			Linux Cluster \\
+SMHI (SE) &	EC-Earth: IFS\_T799/NEMO-ORCA025  &			Ekman AMD Opteron \\
+KNMI (NL) &	ECHAM5/MPIOM	 &				NEC SX-8 \\
+KNMI (NL) &	EC-Earth: IFS\_T159/NEMO-ORCA2 &		SGI Altix, IBM Power \\
+DMI (DK) &	         ECHAM(global)/HIRLAM (reg) &			NEC SX6 \\
+U.Bergen (NO) &	MM5/ROMS & \\
+ICHEC (IE) &	EC-Earth: IFS\_T159/NEMO-ORCA1 & SGI Altix ICE, Bull clust.\\
+ICHEC (IE) &	ROMS/WRF & \\
+NUI Galway (IE) &	ECHAM5/REMO/MPI-OM & \\				
+ETH (CH) & COSMO-CLM/CLM & \\
+ETH (CH) & COSMO-CLM/ROMS & \\
+U. Castille (ES) &	PROMES/U. Madrid ocean &		IBM Power 6 - Intel Itanium \\
+NHM Service (RS) & ECHAM5/MPIOM &   Linux Fedora core 14 \\
+CMC (CA) &  GEM/NEMO  &				IBM Power5 \\		
+UQAM (CA) & 	GEMDM 3.3.2/NEMOv\_2.3.0  & Linux PC \\
+MM (MA) &	ARPEGE-Climat\_V5.1/NEMO-ORCA1 &	IBM \\
+INMT (TN) &	ARPEGE-Climat\_V5.1/NEMO-ORCA2 &	IBM Regata Series \\Oregon St U (USA) & 	PUMA/UVic	 &	 Linux cluster \\
+Hawaii U (USA)	 & ECHAM4/POP &					Linux cluster \\		
+JAMSTEC (JP) & ECHAM/OPA8.2 &					NEC SX8 \\
+JAMSTEC (JP) & ECHAM5\_T106L31/NEMO\_0.5 &			NEC SX8 \\
+Met.Nat.Center (CN) & GRAPES (201x161)/ECOM-si  &	IBM cluster \\
+IAP (CN) &  CREM(reg.)/POM2000  &		SGI \\
+IAP (CN) &  ECHAM/MPIOM & 				Linux\_x64 \\
+CSIRO (AU)  &    ACCESS : UMv7.3/MOM4p1/CICE &	SUN + SGI clusters \\
+BoM (AU)    &   BAM3/ACOM2 &					NEC SX6, SUN \\
+BoM (AU)    &   TCLAPS/MOM  &	NEC SX-6 \\
+U Tasmania (AU) &  Data atm. model/MOM4 &		        SGI O3400 - Compaq5 \\
+\end{longtable}
+
+
+\begin{longtable}{|l|l|l|}
+\caption[Use of OASIS2: centres, coupled models and
+  computing platforms]{Use of OASIS2: centres, coupled models and
+  computing platforms} \label{Tab:OASIS2_a}\\
+
+\hline \multicolumn{1}{|c|}{\textbf{Centre}} &
+\multicolumn{1}{c|}{\textbf{Coupled model}} & \multicolumn{1}{c|}{\textbf{Platform}} \\ \hline 
+\endfirsthead
+
+\multicolumn{3}{c}%
+{{\bfseries \tablename\ \thetable{} -- continued from previous page}} \\
+\hline \multicolumn{1}{|c|}{\textbf{Centre}} &
+\multicolumn{1}{c|}{\textbf{Coupled model}} &
+\multicolumn{1}{c|}{\textbf{Platform}} \\ \hline 
+\endhead
+
+\hline \multicolumn{3}{|r|}{{Continued on next page}} \\ \hline
+\endfoot
+
+\hline \hline
+\endlastfoot
+
+CERFACS (FR) &	ARPEGE3 â OPA8.2/LIM 2deg &				VPP5000 \\
+CERFACS (FR) &	ARPEGE3 â OPA8.1 &					VPP700 \\
+CERFACS (FR) &	ARPEGE2 â OPAICE &					CRAY C90 \\ 
+IPSL (FR) &	LMDz 96x71x19  - OPA/ORCA2  &	VPP5000 \\
+IPSL (FR) &	LMDz 72x45x19 â OPA/ORCA4  	&	VPP5000 \\
+IPSL (FR) &	LMDZ 120X90 - OPA ATL3 1/3 & \\
+IPSL (FR) &	LMDZ 120X90 - OPA ATL1 1 deg & \\
+LODYC (FR) &	IFS T195L31 â OPA8.1 & \\
+LODYC (FR) &	ECHAM4 T30/T42 L14 â OPA/ORCA2 & \\
+M\'et\'eo-France (FR) &	ARPEGE medias â OPAmed 1/8 deg	 &		VPP5000 \\
+M\'et\'eo-France (FR) &	ARPEGE3 - OPA 8.1 + Gelato &				VPP5000 \\
+M\'et\'eo-France (FR) &	ARPEGE 2 T31L19 - OPA8 TDH &	        		CRAY J90 \\
+ECMWF &	IFS T63/T255  - E-HOPE 2deg/1deg  &			IBM Power 4 \\
+ECMWF &	IFS Cy23r4 T159L40 - E-HOPE 256L29 &		VPP700 \\
+ECMWF &	IFS Cy23r4 T95L40  - E-HOPE 256L29 &			VPP700 \\
+ECMWF &	IFS Cy15r8 T63L31  - E-HOPE 128L20 &	 		VPP300 \\
+MPI (DE) &	ECHAM5 T42/L19 - C-HOPE T42+L20 &		NEC-SX \\
+MPI (DE) &	PUMAT42/L19 - C-HOPE 2deg GIN	&		NEC-SX \\
+MPI (DE) &	EMAD - E-HOPE T42+L20	 	&		CRAY C-90 \\
+MPI (DE) &	ECHAM5 T42/L19 - E-HOPE T42+L20 &			NEC-SX \\
+MPI (DE) &	ECHAM4 T30/L19 - E-HOPE T42+L20	&		CRAY T90 \\
+MPI (DE) &	ECHAM4 T30/L19 - E-HOPE T42+L20 &			CRAY C90 \\
+SMHI (SE) &	RCA-HIRLAM (reg.) - RCO-OCCAM (reg.) & \\
+CGAM (UK) &	HadAM3 2.5x3.75 L20 - OPA/ORCA2   &  		T3E \\
+SOC (UK) & 	Interm. Atm. GCM - OCCAM-Lite & \\
+NOC (UK) &	FORTE : IGCM3 (128 x 64) - MOMA (180 x 88) & \\
+JPL (USA) &	TRIDENT â QTCM	 &				Linux workstation \\	
+IRI  (USA) &	ECHAM4 - MOM3	& 				SGI Origin - IBM Power3 \\
+JAMSTEC (JP) &	ECHAM4 - OPA 8.2 &	  				NEC SX5 \\
+BMRC (AU) &    BAM3 - ACOM2 &			NEC SX6 \\
+
+\end{longtable}
+\end{center}
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA4_changes.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA4_changes.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGA4_changes.tex	(revision 4775)
@@ -0,0 +1,388 @@
+\newpage
+
+\chapter{Changes between the different versions of OASIS3-MCT}
+\label{sec_changes}
+
+The evolution between the different versions of OASIS3-MCT can be
+followed in real-time by registering on the Redmine project management
+site at https://inle.cerfacs.fr/ (see "Register" at the right top of
+the page). On this site, registered users can browse the sources and
+consult tickets describing bug fixes and developments. To follow day
+to day evolution of the OASIS3-MCT sources, it is also possible to
+have your e-mail added to the list of addresses to which the log files
+of the SVN checkins are automatically sent; please contact
+oasishelp@cerfacs.fr if you wish to be added to that list.
+
+\section{Changes between OASIS3-MCT\_1.0 and OASIS3-MCT\_2.0}
+\label{sec_oa1_oa2}
+
+The main changes and bug fixes new in OASIS3-MCT\_2.0 are the
+following:
+\begin{itemize}
+
+\item Support of {\tt BICUBIC} interpolation, see paragraph {\tt
+    BICUBIB} in section \ref{subsec_interp}. If the source grid
+    is not a gaussian reduced grid (D), the gradient in the first dimension, 
+    the gradient in the second dimension, and the cross-gradient 
+    of the coupling field must be calculated by the model and 
+    given as arguments to {\tt oasis\_put}, as explained in section \ref{prismput}.
+    If the source grid is a gaussian reduced grid (D), OASIS3-MCT\_2.0 
+    can calculate the interpolated field using only the values of the source
+    field points.
+
+\item Support of {\tt CONSERV/SECOND} regridding, see paragraph {\tt
+    CONSERV/SECOND} in section \ref{subsec_interp}.
+
+\item Support of components exchanging data on only a subdomain of the
+  global grid: a new optional argument, ig\_size was added to
+  oasis\_def\_partition, that provides the user with the ability to
+  define the total number of grid cells on the grid (see section
+  \ref{subsubsec_Partition}).
+
+%\item The CPP key "balance" in mod\_oasis\_advance was added; this
+%  option can be used to produce timestamps in OASIS debug file (see
+%  section \ref{subsec_cpp}).
+
+\item The variable {\tt TIMER\_Debug} controlling the amount of time
+  statistics written out is now an optional argument read in the {\it
+    namcouple}; see the {\tt NLOGPRT} line in
+  \ref{subsec_namcouplefirst} and all details about time statistics in
+  section \ref{timestat}.
+
+\item Specific problems in writing out the time statistics when all
+  the processors are not coupling were solved (see Redmine issue
+  \#497)
+
+\item The problem with restart files when one coupling field is sent
+  to 2 target components was solved (see Redmine ticket \#522)
+
+\item A memory leak in mod\_oasis\_getput\_interface.F90 was fixed
+  thanks to R. Hill from the MetOffice (see Redmine ticket \#437)
+
+\item A bug fix was provided to ensure that the nearest neighbour
+  option is activated when the option {\tt FRACNNEI} is defined in the
+  {\it namcouple} for the conservative interpolation .
+
+\item The behaviour of OASIS3-MCT was changed in the case a
+  component model tries to send with {\tt oasis\_put} a field declared
+  with a {\tt oasis\_def\_var} but not defined in the configuration
+  file {\it namcouple}; this will now lead to an abort. In this case,
+  the field ID returned by the {\tt oasis\_def\_var} is equal to -1
+  and the corresponding {\tt oasis\_put} should not be called.
+
+\item OASIS3-MCT developments are now continuously tested and
+  validated on different computers with a test suite under Buildbot,
+  which is a software written in Python to automate compile and test
+  cycles required in software project (see
+  https://inle.cerfacs.fr/projects/oasis3-mct/wiki/Buildbot on the
+  Redmine site).
+
+\end{itemize}
+
+\section{Changes between OASIS3.3 and OASIS3-MCT\_1.0}
+
+\subsection{General architecture}
+\label{sec_changes_gen}
+
+\begin{itemize}
+\item OASIS3-MCT is (only) a coupling library
+
+Much of the underlying implementation of OASIS3 was refactored to
+leverage the Model Coupling Toolkit (MCT). OASIS3-MCT is a coupling
+library to be linked to the component models and that
+carries out the coupling field transformations (e.g. remappings/interpolations)
+in parallel on either the source or target processes and that performs
+all communication in parallel directly between the component models; there
+is no central coupler executable anymore\footnote{As with OASIS3.3,
+  the ``put'' calls are non-blocking but the ``get'' calls are
+blocking. As before, the user has to take care of implementing a coupling
+algorithm that will result in matching ``put'' and ``get'' calls to
+avoid deadlocks (see section \ref{subsubsec_sendingreceiving}). The lag (LAG) index works as
+before in OASIS3.3 (see section \ref{subsubsec_Algoritms})}. 
+
+\item {\tt MAPPING} transformation to use a pre-defined mapping file
+
+With {\tt MAPPING}, OASIS3-MCT has the ability to read a predefined
+set of weights and addresses (mapping file) specified in the {\it
+  namcouple} to perform the interpolation/remapping. The user also has
+the flexibility to choose the location and the parallelization strategy of the
+remapping with specific {\tt MAPPING} options (see section \ref{subsec_interp}).
+
+\item Mono-process mapping file generation with the SCRIP library
+
+But as before, OASIS3-MCT\_1.0 can
+also generate the mapping file using the SCRIP library
+\citep{Jones99}. When this is the case, the mapping file generation is
+done on one process of the model components; all previous {\tt SCRIPR} remapping
+schemes available in OASIS3.3 are still supported besides {\tt
+  BICUBIC} and {\tt CONSERV/SECOND}. (Note: these remapping schemes, not available in OASIS3-MCT\_1.0 
+  were reactivated in OASIS3-MCT\_2.0, see \ref{sec_oa1_oa2}.)
+
+\item MPI2 job launching is NOT supported. 
+
+  Only MPI1 start mode is allowed. As before with the MPI1 mode, all
+  component models must be started by the user in the job script in a
+  pseudo-MPMD mode; in this case, they will automatically share the
+  same {\tt MPI\_COMM\_WORLD} communicator and an internal
+  communicator created by OASIS3-MCT needs to be used for internal
+  parallelization (see section \ref{subsec_MPI1}).
+
+\end{itemize}
+
+\subsection{Changes in the coupling interface in the component models}
+\label{sec_changes_API}
+
+\begin{itemize}
+
+\item Use statement
+
+The different OASIS3.3 {\tt USE} statements were gathered into one {\tt
+  USE mod\_oasis} (or one {\tt USE mod\_prism}), therefore much
+  simpler to use.
+
+\item Support of previous {\tt prism\_xxx} and new {\tt oasis\_xxx}
+  interfaces
+
+OASIS3-MCT retains prior interface names of OASIS3.3
+  (e.g. {\tt prism\_put\_proto}) to ensure full backward
+  compatibility. However, new interface names such as {\tt
+    oasis\_put} are also available and should be prefered. Both
+  routine names are listed in chapter \ref{sec_modelinterfacing}.
+
+\item Auxiliary routines not supported yet
+
+Auxiliary routines {\tt prism\_put\_inquire}, {\tt
+  prism\_put\_restart\_proto}, {\tt prism\_get\_freq} are not
+  supported yet.
+
+\item Support of components for which only a subset of processes
+  participate in the coupling
+
+New routines {\tt oasis\_create\_couplcomm} and {\tt
+  oasis\_set\_couplcomm} are now available to create or set a coupling
+  communicator in the case only a subset of the component processes
+  participate in the coupling (see section \ref{subsec_subset}). But
+  even in this case, all OASIS3-MCT interface routines, besides the
+  grid definition (see section \ref{subsubsec_griddef}) and the
+  ``put'' and `` get'' call per se (see section
+  \ref{subsubsec_sendingreceiving}), are collective and must be called
+  by all processes.
+
+\item New routines {\tt oasis\_get\_debug} and {\tt oasis\_set\_debug}
+
+New routines {\tt oasis\_get\_debug} and {\tt oasis\_set\_debug}
+  are now available to respectively retrieve the current OASIS3-MCT
+  internal debug level (set by {\tt \$NLOGPRT} in the {\it namcouple}) or to change it (see section
+  \ref{subsubsec_auxroutines}).
+
+\end{itemize}
+
+\subsection{Functionality not offered anymore}
+\label{sec_changes_old}
+
+\begin{itemize}
+
+\item {\tt SCRIPR/BICUBIC} and {\tt SCRIPR/CONSERV/SECOND} remappings
+
+As in OASIS3.3, the SCRIP library can be used to generate the
+  remapping/interpolation weights and addresses and write them to a
+  mapping file. All previous {\tt SCRIPR} remapping
+schemes available in OASIS3.3 are still supported in OASIS3-MCT\_1.0 besides {\tt
+  BICUBIC} and {\tt CONSERV/SECOND} because these remapping involve
+at each source grid point the value of the field but also the value of the
+gradients of the field (which are not known or calculated). (Note: these remapping schemes, 
+not available in OASIS3-MCT\_1.0 were reactivated in OASIS3-MCT\_2.0, see \ref{sec_oa1_oa2}.)
+
+\item Vector field remapping
+
+Vector field remapping is not and will not be supported (see ``Support
+  of vector fields with the SCRIPR remappings'' in section \ref{subsec_interp}).
+
+\item Automatic calculation of grid mesh corners in {\tt SCRIPR/CONSERV}
+
+For {\tt SCRIPR/CONSERV} remapping, grid mesh corners will not
+  be compute automatically if they are needed but not provided.  
+
+\item Other transformations not supported
+
+\begin{itemize}
+
+\item The following transformations are not available in OASIS3.3
+and will most probably not be implemented as it should be not
+too difficult to implement the equivalent operations in the component
+models themselves: {\tt CORRECT}, {\tt FILLING}, {\tt SUBGRID}, {\tt MASKP}
+
+\item {\tt LOCTRANS/ONCE} is not explicitely offered as it is equivalent to
+defining a coupling period equal to the total runtime.
+
+\item The following transformations are not available as they were already
+deprecated in OASIS3.3 (see OASIS3.3 User Guide): {\tt REDGLO}, {\tt INVERT},
+{\tt REVERSE}, {\tt GLORED}
+
+\item {\tt MASK} and {\tt EXTRAP} are not available but the corresponding
+linear extrapolation can be replaced by the more efficient option
+using the nearest non-masked source neighbour for target points having
+their original neighbours all masked. This is now the default option for {\tt SCRIPR/}{\tt DISTWGT}, {\tt GAUSWGT} and {\tt BILINEAR} interpolations. It is
+also included in \newline {\tt SCRIPR/CONSERV} if {\tt FRACNNEI}
+normalization option is chosen (see section \ref{subsec_interp}).
+
+\item {\tt INTERP} interpolations are not available; {\tt SCRIPR}
+  should be used instead.
+
+\item {\tt MOZAIC} is not available as {\tt MAPPING} should be used
+  instead.
+
+\item{\tt NOINTERP} does not need to be specified anymore if no
+  interpolation is required.
+ 
+\item Field combination with {\tt BLASOLD} and {\tt BLASNEW}; these
+  transformations only support multiplication and addition terms to
+the fields (see section \ref{subsec_preproc}). 
+
+\end{itemize}
+
+\item Using the coupler in interpolator-only mode
+
+This is not possible anymore as OASIS3-MCT is now only a coupling
+library. However, it is planned, in a further release, to provide a
+toy coupled model that could be use to check the quality of the
+remapping for any specific couple of grids.
+
+\item Coupling field CF standard names
+
+The file cf\_name\_table.txt is not needed or used anymore. The CF
+  standard names of the coupling fields are not written to the debug
+  files.
+
+\item Binary auxiliay files
+
+All auxiliary files, besides the {\it namcouple} must be NetCDF;
+  binary files are not supported anymore.
+\end{itemize}
+
+\subsection{New functionality offered}
+\label{sec_changes_new}
+
+\begin{itemize}
+
+\item Better support of components for which only a subset of processes
+  participate in the coupling
+
+In OASIS3.3, components for which only a subset of processes
+  participated in the coupling were supported in a very restricted
+  way. In fact, this subset had to be composed of the N first
+  processes and N had to be specified in the {\it namcouple}. Now, the
+  subset of processes can be composed of any of the component
+  processes and does not have to be pre-defined in the {\it
+    namcouple}. New routines {\tt oasis\_create\_couplcomm} and {\tt
+  oasis\_set\_couplcomm} are now available to create or set a coupling
+  communicator gathering only these processes (see section \ref{subsec_subset}).
+
+\item Exact restart for {\tt LOCTRANS} transformations
+
+If needed, LOCTRANS transformations write partially
+  transformed fields  in the coupling restart file at the end of a run
+  to ensure an exact restart of the next run (see section
+  \ref{subsec_timetrans}). For that
+  reason, coupling restart filenames are now required for all {\it
+    namcouple} entries that use LOCTRANS (with non INSTANT
+  values). This is the reason an optional restart file is now provided
+  on the OUTPUT {\it namcouple} input line. If the coupling periods of
+  two (or more) coupling fields are different, it is necessary to define 
+  two (or more) restart files, one for each field.
+
+\item Support to couple multiple fields via a single communication.
+
+ This is supported through colon
+delimited field lists in the {\it namcouple}, for example 
+
+{\tt ATMTAUX:ATMTAUY:ATMHFLUX  TAUX:TAUY:HEATFLUX 1 3600 3 rstrt.nc EXPORTED}
+
+ in a single {\it namcouple} entry. All fields will use the
+{\it namcouple} settings for that entry. In the component model codes,
+these fields are still sent (``put'') or received (``get'') one at a
+time. Inside OASIS3-MCT, the fields are stored and a single mapping
+and send or receive instruction is executed for all fields. This is
+useful in cases where multiple fields have the same coupling
+transformations and to reduce communication costs by aggregating multiple 
+fields into a single communication. If a LOCTRAN transformation is needed
+for these multiple fields, it is necessary to define a restart file for 
+these multiple fields. {\bf The coupling fields must be sent and received in the same order 
+as they are defined in the corresponding single entry of the namcouple}.
+
+\item Matching one source filed with multiple targets
+
+  A coupling field sent by a source component model can be associated
+  with more than one target field and model (get). In that case, the
+  source model needs to send (``put'') the field only once and the
+  corresponding data will arrive at multiple targets as specified in
+  the {\it namcouple} configuration file. Different coupling
+  frequencies and transformations are allowed for different coupling
+  exchanges of the same field. If coupling restart files are required
+  (either if a {\tt LAG} or if a {\tt LOCTRANS} transformation is
+  specified), it is mandatory to specify different files for the
+  different fields.
+
+%In addition, a single
+%  coupling field can be sent to the same destination model using
+%  multiple transforms as long as the destination field name is
+%  unique.
+The inverse feature is not allowed, i.e. a single target (get) field
+CANNOT be associated with multiple source (put) fields.
+
+\item The debug files
+
+The debug mode was greatly improved as compared to OASIS3.3. The level
+of debug information written out to the OASIS3-MCT debug files for
+each model process is defined by the \$NLOGPRT value in the {\it
+  namcouple}. All details are provided in section
+\ref{subsec_namcouplefirst}.
+
+\end{itemize}
+
+\subsection{Changes in the configuration file {\it namcouple}}
+\label{sec_changes_namcouple}
+
+\begin{itemize}
+
+\item The {\it namcouple} configuration file of OASIS3-MCT is fully backward
+compatible with OASIS3.3. However, several {\it namcouple} keywords
+have been deprecated even if they are still 
+allowed.  These keywords are noted ``UNUSED'' in sections
+\ref{subsec_namcouplefirst} and \ref{subsec_namcouplesecond} and are
+not fully described. Information below these keywords will not be read
+and will not be used: \$SEQMODE , \$CHANNEL, \$JOBNAME, \$INIDATE,
+\$MODINFO, \$CALTYPE.
+
+\item Also the following inputs should not appear in the {\it namcouple}
+anymore as the related functionality are not supported anymore in
+OASIS3-MCT (see above): field status AUXILARY, time transformation
+ONCE, REDGLO, INVERT, MASK, EXTRAP, CORRECT, INTERP, MOZAIC, FILLING,
+SUBGRID, MASKP, REVERSE, GLORED. 
+
+\item To get 2D fields in the debug output NetCDF files, the 2D dimensions of the
+  grids must be provided in the {\it namcouple} (except if the field
+  has the status OUTPUT); otherwise, the fields in the debug output files will be 1D.
+
+\end{itemize}
+
+\subsection{Other differences}
+\label{sec_changes_other}
+
+\begin{itemize}
+
+\item IGNORED and IGNOUT fields are converted to EXPORTED and EXPOUT
+  respectively.
+
+\item The file {\tt areas.nc} is not needed anymore to calculate some
+  statistics with options CHECKIN and/or CHECKOUT (see section \ref{subsec_preproc}).
+
+\item SEQ index is no longer needed to ensure correct coupling
+  sequencing within the coupler. Use of SEQ allows the coupling layer
+  to detect potential deadlocks before they happen and to exit
+  gracefully (see section \ref{subsec_sec}).
+
+\item The I/O library mpp\_io is no longer used to write the restart and output files.
+
+
+\end{itemize}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGRefs.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGRefs.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UGRefs.tex	(revision 4775)
@@ -0,0 +1,129 @@
+\newpage
+\begin{thebibliography}{10}
+\vspace{-0.3cm}
+\bibitem[{Cassou et~al 1998}]{cassou}
+Cassou, C., P.~Noyret, E.~Sevault, O.~Thual, L.~Terray, D.~Beaucourt, and
+  M.~Imbard:
+\newblock Distributed Ocean-Atmosphere Modelling and Sensitivity to the
+  Coupling Flux Precision: the CATHODe Project.
+\newblock {\em Monthly Weather Review}, 126, No 4: 1035-1053, 1998.
+
+\bibitem[{Guilyardi et~al 1995}]{guily95}
+Guilyardi, E., G.~Madec, L.~Terray, M.~D\'equ\'e, M.~Pontaud, M.~Imbard, D.~Stephenson, M.-A. ~Filiberti, D.~Cariolle, P.~Delecluse, and O.~Thual. 
+\newblock Simulation coupl\'ee oc\'ean-atmosph\`ere de la variabilit\'e du climat.
+\newblock {\em C.R. Acad. Sci. Paris}, t. 320, s\'erie IIa:683--690, 1995. 
+
+\bibitem[{Jacob et~al 2005}]{mct_jacob}
+Jacob, R., J.~Larson, and E.~Ong:
+\newblock MxN Communication and Parallel Interpolation in CCSM3 Using the Model Coupling Toolkit.
+\newblock {\em Int. J. High Perf. Comp. App.}, 19(3), 293-307 2005
+
+\bibitem[{Jones 1999}]{Jones99}
+Jones, P.: Conservative remapping: First- and second-order conservative
+  remapping, Mon Weather Rev, 127, 2204-2210, 1999. 
+
+\bibitem[{Larson et~al 2005}]{mct_larson} 
+Larson, J., R.~Jacob, and E.~Ong:
+\newblock The Model Coupling Toolkit: A New Fortran90 Toolkit for Building Multiphysics Parallel Coupled Models.
+\newblock {\em Int. J. High Perf. Comp. App.}, 19(3), 277-292, 2005
+
+\bibitem[{Noyret et~al 1994}]{noyret}
+Noyret, P., E.~Sevault, L.~Terray and O.~Thual.
+\newblock Ocean-atmosphere coupling. 
+\newblock {\em Proceedings of the Fall Cray User Group (CUG) meeting},
+1994.
+
+\bibitem[{Pontaud et~al 1995}]{pontaud}
+Pontaud, M., L.~Terray, E.~Guilyardi, E.~Sevault, D.~B. Stephenson, and
+  O.~Thual.
+\newblock Coupled ocean-atmosphere modelling - computing and scientific
+  aspects.
+\newblock In {\em 2nd UNAM-CRAY supercomputing conference, Numerical
+  simulations in the environmental and earth sciences}
+\newblock Mexico-city, Mexico, 1995.
+
+ \bibitem[{Sevault et~al 1995}]{clim2}
+Sevault, E., P.~Noyret, and L.~Terray.
+\newblock Clim 1.2 user guide and reference manual.
+\newblock {\em Technical Report TR/CGMC/95-47}, CERFACS, 1995.
+
+\bibitem[{Terray and Thual 1995b}]{clim1}
+Terray, L. and O.~Thual.
+\newblock Oasis: le couplage oc\'ean-atmosph\`ere.
+\newblock {\em La M\'et\'eorologie}, 10:50--61, 1995.
+
+\bibitem[{Terray and Thual 1993}]{terray1}
+Terray, L. and O.~Thual.
+\newblock Coupled ocean-atmosphere simulations. 
+\newblock In {\em High Performance Computing in the Geosciences,
+proceedings of the Les Houches Workshop}
+\newblock F.X. Le Dimet Ed., Kluwer Academic Publishers B.V, 1993.
+
+\bibitem[{Terray et~al 1995}]{clim3}
+Terray, L., E.~Sevault, E.~Guilyardi and O.~Thual
+\newblock OASIS 2.0 Ocean Atmosphere Sea Ice Soil User's Guide and Reference Manual
+\newblock {\em Technical Report TR/CGMC/95-46}, CERFACS, 1995.
+
+\bibitem[{Terray et~al 1995b}]{terray95}
+Terray, L. O.~Thual, S.~Belamari, M.~D\'equ\'e, P.~Dandin, C.~L\'evy, and
+P.~Delecluse. 
+\newblock Climatology and interannual variability simulated by the arpege-opa
+model. 
+\newblock {\em Climate Dynamics}, 11:487--505, 1995
+
+\bibitem[{Terray et~al 1999}]{terray3}
+Terray, L., S.~Valcke and A.~Piacentini:
+\newblock OASIS 2.3 Ocean Atmosphere Sea Ice Soil, User's Guide and
+Reference Manual,
+\newblock {\em Technical Report TR/CMGC/99-37}, 
+\newblock CERFACS, Toulouse, France, 1999.
+
+\bibitem[{Valcke 2013}]{valcke8}
+Valcke, S.: 
+\newblock The OASIS3 coupler: a European climate modelling community software
+\newblock {\em Geosci. Model Dev.}, 6:373--388
+
+\bibitem[{Valcke et~al 2012}]{valcke7}
+Valcke, S., T.~Craig, L.~Coquart: 
+\newblock OASIS3-MCT User Guide, OASIS3-MCT 1.0, 
+\newblock {\em Technical Report, WN/CMGC/12/49},  
+\newblock CERFACS, Toulouse, France, 2012.
+
+\bibitem[{Valcke et~al 2011}]{valcke6}
+Valcke, S., M.~Hanke, L.~Coquart:
+\newblock OASIS4\_1 User Guide
+\newblock {\em Technical Report TR/CMGC/11/50}, 
+\newblock CERFACS, Toulouse, France, 2011. 
+
+\bibitem[{Valcke 2006b}]{valcke5}
+Valcke, S.: 
+\newblock OASIS3 User Guide (prism\_2-5) 
+\newblock {\em Technical Report TR/CMGC/06/73}, 
+\newblock CERFACS, Toulouse, France, 2006. 
+
+\bibitem[{Valcke 2006a}]{valcke4}
+Valcke, S.: 
+\newblock OASIS4 User Guide (OASIS4\_0\_2), 
+\newblock {\em Technical Report TR/CMGC/06/74}, 
+\newblock CERFACS, Toulouse, France, 2006. 
+
+\bibitem[{Valcke et~al 2004}]{valcke3}
+Valcke, S., A.~Caubel, R.~Vogelsang, and D.~Declat:       
+\newblock OASIS3 User's Guide (oasis3\_prism\_2-4),
+\newblock {\em PRISM Report No 2, 5th Ed.}, 
+\newblock CERFACS, Toulouse, France, 2004.
+
+\bibitem[{Valcke et~al 2003}]{valcke2}
+Valcke, S., A.~Caubel, D.~Declat and L.~Terray:        
+\newblock OASIS3 Ocean Atmosphere Sea Ice Soil User's Guide,
+\newblock {\em Technical Report TR/CMGC/03-69}, 
+\newblock CERFACS, Toulouse, France, 2003.
+
+\bibitem[{Valcke et~al 2000}]{valcke1}
+Valcke, S., L.~Terray and A.~Piacentini:
+\newblock OASIS 2.4 Ocean Atmosphere Sea Ice Soil, User's Guide and
+Reference Manual,
+\newblock {\em Technical Report TR/CMGC/00-10}, 
+\newblock CERFACS, Toulouse, France, 2000.
+
+\end{thebibliography}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG_Acknowledgements.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG_Acknowledgements.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/UG_Acknowledgements.tex	(revision 4775)
@@ -0,0 +1,79 @@
+\newpage
+%%
+%\addcontentsline{toc}{section}{Acknowledgements}
+%\centerline{\bf Acknowledgements}
+.
+
+\vspace{3cm}
+
+{\bf ACKNOWLEDGMENTS}
+ 
+\vspace{1.5cm}
+ We would like to thank the main past or present developers of OASIS
+are (in alphabetical order, with the name of their institution at the time of their contribution to OASIS):
+
+Arnaud Caubel (LSCE/IPSL \& FECIT/Fujitsu),
+Damien Declat (CERFACS),
+Italo Epicoco (CMCC),
+Veronika Gayler (MPI-M\&D),
+Josefine Ghattas (CERFACS),
+Jean Latour (CERFACS \& Fujitsu-Fecit),
+Eric Maisonnave (CERFACS),
+Silvia Mocavero (CMCC),
+Elodie Rapaport (CERFACS),
+Hubert Ritzdorf (CCRLE-NEC),
+Sami Saarinen (ECMWF),
+Eric Sevault (M\'et\'eo-France),
+Laurent Terray (CERFACS),
+Olivier Thual (CERFACS),
+Reiner Vogelsang (SGI Germany),
+Li Yan (CERFACS).
+
+\vspace{0.5cm}
+We also would like to thank the following people for their help
+and suggestions in the design of the OASIS software (in alphabetical
+order, with the name of their institution at the time of their contribution to OASIS):
+
+Dominique Astruc (IMFT),
+Chandan Basu (NSC, Sweden),
+Sophie Belamari (M\'et\'eo-France),
+Dominique Bielli (M\'et\'eo-France),
+Gilles Bourhis (IDRIS),
+Pascale Braconnot (IPSL/LSCE),
+Sandro Calmanti (M\'et\'eo-France),
+Christophe Cassou (CERFACS),
+Yves Chartier (RPN),
+Jalel Chergui (IDRIS),
+Philippe Courtier (M\'et\'eo-France),
+Philippe Dandin (M\'et\'eo-France),
+Michel D\'equ\'e (M\'et\'eo-France),
+Ralph Doescher (SMHI),
+Jean-Louis Dufresne (LMD),
+Jean-Marie Epitalon (CERFACS),
+Laurent Fairhead (LMD),
+Uwe Fladrich (SMHI),
+Marie-Alice Foujols (IPSL),
+Gilles Garric (CERFACS),
+Eric Guilyardi (CERFACS),
+Charles Henriet (CRAY France),
+Pierre Herchuelz (ACCRI),
+Maurice Imbard (M\'et\'eo-France),
+Luis Kornblueh (MPI-M),
+Stephanie Legutke (MPI-M\&D),
+Claire L\'evy (LODYC),
+Olivier Marti (IPSL/LSCE),
+S\'ebastien Masson (IPSL/LOCEAN)
+Claude Mercier (IDRIS),
+Pascale Noyret (EDF),
+Andrea Piacentini (CERFACS),
+Marc Pontaud (M\'et\'eo-France),
+Adam Ralph (ICHEC),
+Ren\'e Redler (MPI-M),
+Tim Stockdale (ECMWF),
+Rowan Sutton (UGAMP),
+V\'eronique Taverne (CERFACS),
+Jean-Christophe Thil (UKMO),
+Nils Wedi (ECMWF).
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisga.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisga.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisga.tex	(revision 4775)
@@ -0,0 +1,865 @@
+ \magnification =\magstep1
+\count0=77
+%definitions
+
+%end of definitions
+
+
+\centerline{ Olivier Thual, March 15$^{\rm th}$ 1992}
+\centerline{ Revised version  June 30$^{\rm th}$ 1992}
+ \bigskip
+
+\centerline{\bf SIMPLE OCEAN-ATMOSPHERE INTERPOLATION.}  
+\centerline{\bf PART A: THE METHOD}
+
+\bigskip
+ epi920629-naiva-ot6.tex
+A simple and naive method to interpolate fields between an atmospheric
+and an oceanic grid is presented. This crude method is coded into a set of
+FORTRAN programs, in the expectation  of a more elaborated method which
+takes into account the particular physic of the ocean-atmosphere coupling. 
+
+
+
+\beginsection 1. INTRODUCTION 
+
+The coupling of an atmosphere General Circulation Model (GCM) and an 
+oceanic GCM involves both a temporal coupling,  which  deals  with
+the synchronization and the communication between  the two codes at
+suitable time steps, and a spatial coupling which  deals with the
+interpolations of suitable fields from one GCM grid to another, namely the
+fluxes from the atmospheric to the ocean grid, and the sea surface
+temperature (SST) in the reverse direction.  
+
+
+
+These two aspects of the coupling are presently attacked in parallel in the
+CERFACS Climate Modelling \& Global Change team.  They have started
+with a gathering of all the state of art informations that we have been
+able to record in the Climatic community and that have been summarized
+in [1]. Today, progress has been made  in the two directions.
+
+ In [2], a method based on the communication and synchronization of  UNIX
+processes is developed for the GCMs temporal coupling task. The skeleton
+of a universal ``coupler'' has been written in FORTRAN.
+This software 
+controls all  the exchanges between an oceanic and an atmospheric codes.
+Its present conception allows a simple
+implementation in an already written and tested GCM, with   minimum
+coding changes in it.
+
+
+
+This coupler skeleton includes a black box which will  perform the spatial
+interpolations between the atmospheric and  oceanic grids. Different 
+interpolation schemes can be plugged in this black box, which further
+increases the universality of the coupler.  The fundamental basis for the
+design of an advanced interpolation scheme is presented in [3]. In this
+scheme a particular focus is made on the ``local conservation'' of the
+fluxes when the interpolation from the atmospheric to the oceanic grid is
+performed. It is thought ([3]) than the non-conservation of the fluxes
+might be one of the causes of  the drift problem encountered when two  GCMs,
+individually well tuned, are coupled together. 
+
+
+
+In the expectation of the achievement and coding of this advanced
+interpolation scheme, it has appeared necessary to plug into the coupler
+spatial interpolation black box a simple and quickly written package of
+FORTRAN subroutines  in order to start real size tests of the coupler with
+ GCMs.  The purpose of this letter is to expose the
+``naive'' and crude interpolation method that we have chosen in this spirit.
+It is based on the informations that we have collected in our inquiry on the
+state of the art spread among the climatic community (see [4]) and
+summarized in [1]. 
+
+A basic introduction to the interpolation of data grid points is presented
+in Section 1, and the specific problem of the grid-to-grid interpolation is
+discussed in Section 2. These two sections are finalized by the description
+of the ``naive interpolation method'' that will be plugged into the coupler
+black box. This method have been coded in FORTRAN and is now under a
+testing stage.  The results of the tests will be exposed in Part B of this
+letter. In Section 3, some steps towards the design of a less naive
+grid-to-grid interpolation method are indicated, and could be easily
+implemented in the ``naive method'' FORTRAN software, if they are
+retained as pertinent developments worth the effort.
+
+
+A lot of materials exposed here, at a pedagogical and
+simple level, are presented in a more complete and detailled manner in [3].
+This is the case, for instance, for  the gaussian basis and overlapping of
+Sections 2 and 3, and of the Lagrangian formalism. For furthers details, and
+in particular numerical tests of various interpolation methods in the 1D
+case, the reader is referred to [3].
+
+
+
+
+ 
+
+\beginsection  2.  BASIC FACTS ABOUT INTERPOLATION 
+
+Interpolation is a problem that often occurs in physics, and we all have
+had some experience in it, in a way or another.  Due to the numerous
+approachs that can be found in the literature, I  have chosen to build a
+pedagogical presentation from scratch, restricted to the materials
+necessary to expose the ``naive method''  that I have coded.  Simple
+notations for the indexing of masked grids are given, in order to be used
+in  this presentation. The family  of the linear  interpolations associated to a 
+grid is presented in a formalism focusing  their  functions basis set.
+Several illustrative examples are presented, ending with exposition of the
+``$L$-neighbor naive method''.
+
+
+
+\beginsection 2.1 Grids and masks
+
+Let $r_{lm}= (x _{lm}, y _{lm})$, $ \; l=1,N_1$, $ \; m=1,N_2$ the
+coordinates of a rectangular 2D grid.  In order to define the sea and the
+land, let $M _{lm}$ a $N_1 \times N_2$ matrix called ``mask'' such that,
+for instance,  $M _{lm}=1$ means that  $r_{lm}$ is a ``sea'' grid and  $M
+_{lm}=0$ means that  $r_{lm}$ is a ``land'' grid. In all the present
+discussion, we will only consider the sea points of the grid and discard the
+land points.  If  $N$ is the number of sea grid points  we will denote them
+by $r_i=(x_i, y_i),\; i=1,N$ and no mask  needs to  be mentioned anymore in
+the presentation  of the sea grid. The notion of mask is still useful
+however in the numerical implementation of  algorithms dealing  with
+thoses grids. Another advantage  is the convenient generalization of the
+notations to 1D or 3D grids. 
+
+
+
+
+
+\beginsection 2.2 The linear interpolation family of a grid
+
+The most common meaning of the word interpolation when dealing with a
+grid $(r_i),\;  i=1,N$ with a real  value $(a_i),\; i=1,N$
+ at each point is the
+determination of a function $f(r)$ on the whole space (1D, 2D or 3D
+depending on the case), which allows to extrapolate the values $a_i$'s in
+any point $r$ located on or outside the grid.  
+Note that an interpolation does not necessarily requires $f(r_i)=a_i$. 
+
+
+
+ Any  linear interpolation method can be expressed as
+$$
+f(r)= \sum_{i=1}^{N} a_i \varphi_i(r)
+\eqno(2.1)
+$$
+where the $ \varphi_i(r)$'s are  functions localized around $r_i$ such that,
+for all $r$: 
+$$
+ \sum_{i=1}^{N}\varphi_i(r) dr = 1
+\eqno(2.2)
+$$
+for all $i$. 
+Let us call call these functions ``the basis'' of the interpolation.
+ 
+
+
+For a given grid, the family of all the possible interpolations of the form
+(2.1) is as big as all the possible  choices of the basis functions. 
+The choice of a particular interpolation depends on physical
+considerations, which  depend on  the use that one intends to make 
+of the function $f(r)$. 
+
+
+
+\medskip
+
+Let us  assume that the 
+ general shape of the $ \varphi_i(r)$'s is more or less the same on all
+the grid. This is the case,  for instance, when 
+ a given  $ \varphi_i(r)$ ``covers''
+ roughly the same number of
+neighbors for most of the points of the grid. 
+It  is then  possible to define the ``overlap order'' of an interpolation 
+by looking at 
+how much  the support of the $ \varphi_i(r)$'s overlap, taking into account
+how fast   the absolute  value of $ \varphi_i(r)$.
+
+ There is no need here to
+give a more precise definition that this intuitive concept of ``overlap
+order''. 
+
+\vfill\eject
+
+
+\beginsection 2.3  The ``closest neighbor'' interpolation 
+
+Given a distance in the space where stands the grid, for instance 
+ on  a plane or on a
+sphere),  the ``closest neighbor'' interpolation is such that
+ $f(r)=a_{i(r)}$, where
+  $a_{i(r)}$  is the  value data at the closest neighbor 
+ $r_{i(r)}$, i.e. the grid point which minimizes the
+distances $(|r-r_i|), \; i=1,N$.  
+
+
+
+This  interpolation can be expressed under the form (2.1) with
+$\varphi_i(r)$ being 1 on the open domain $S_i$ of all the points
+$r$ which admit $r_i$ as their closest neighbor and  $|S_i|$  its area.  It
+is  1/2 on the boundary  of this domain for the  points at equal distance
+from 2 grid points, 
+1/4 at the ``corners'' at equal distance of 4 grid points, and so on.
+  It is zero outside of the domain $S_i$. 
+
+
+
+The overlap order of this interpolation is zero, because the support domains
+$S_i$ of the basis functions do not intersect.  The function $f(r)$  of this
+interpolation is discontinuous. 
+
+\vfill\eject
+
+\beginsection 2.4 Familiar Interpolations
+
+The linear interpolation is simple to understand on a 1D grid. Given $N$
+values  $(a_i) i=1,N$ at the  real  points $(x_i),\; i=1,N$ the linear
+interpolation reads:
+$$
+f(x)=(a_{i+1}-a_i) { x-x_i \over x_{i+1} - x_i }  + a_i
+\qquad \hbox{if} \quad x\in [x_i, x_{i+1}] \;,
+\eqno(2.3)
+$$
+i.e.  a piece linear function such that $f(x_i)=a_i$ for all points.
+
+
+
+Simple algebraic manipulations show that  this interpolation  can be put
+under the form (2.1) with 
+$$
+\varphi_i(x)=\left\{\matrix{ 
+{x-x_{i-1}\over  x_{i}-x_{i-1} }
+\qquad \hbox{if} \quad x\in [x_{i-1}, x_{i}]  \cr
+{x-x_{i+1}\over  x_{i}-x_{i+1} }
+\qquad \hbox{if} \quad x\in [x_{i}, x_{i+1}]  \cr
+0
+\qquad \hbox{elsewhere}}  \right.
+\eqno(2.4)
+$$
+This function is equal to one at $x_i$, zero at the point $x_{i-1}$ and
+$x_{i+1}$ and outside $ [x_{i-1}, x_{i+1}]$, and is piecewise linear on two
+intervals. 
+ 
+
+
+
+\bigskip
+
+The linear interpolation on a 2D grid $r_{lm}=(x_{lm},y_{lm})$ can also be
+put under the form
+$$
+f(r)= \sum_{l,m} a_{lm} \varphi_{lm}(r)
+\eqno(2.5)\;,
+$$
+with $\varphi_{lm}(r)$ equal to one at $r_{lm}$, zero at  the four points
+$r_{l-1,m-1}$,  $r_{l+1,m-1}$,  $r_{l+1,m+1}$,  $r_{l-1,m+1}$ and outside
+the  polygon that they form, and piecewise linear on four triangles that
+they make with $r_{lm}$.
+
+
+
+\bigskip
+
+It can be said that the overlap order of the linear interpolation is one,
+as two basis functions can overlap on one grid mesh.  It is intuitive to say
+that the higher the overlap, the smoother the interpolation.  
+I will not try  to consider  here interpolations like quadratic interpolations 
+or splines, which certainly enter into the form (2.1). 
+
+  
+
+\beginsection 2.5 ``Unique weight function'' interpolation 
+
+Instead I will study a very natural interpolation base on the choice  of a
+``weight function''  $\phi(u)$, which can be, as an example, a gaussian:
+$$
+\phi(u)= e^{-{u^2 \over 2\sigma^2}} \;.
+\eqno(2.6)
+$$
+The normalization constant in front of the  exponential can be anything as 
+will be seen below.  
+
+
+
+With the choice of a ``weight function''  one  can define the  interpolation 
+$$
+f(r)= {1\over Z(r)} \sum_{i=1}^{N} a_i\;  \phi(r-r_i)\;,
+\eqno(2.7)
+$$
+where 
+$$
+Z (r)=  \sum_{i=1}^{N}  \phi(r-r_i)\;,
+\eqno(2.8)
+$$
+to ensure (2.2).
+This function $Z(r)$ depends on the geometry of the grid and on the weight
+function $\phi$, and its graphic visualization might give some valuable
+information about the  chosen method.  The same remark holds for the
+individual $ \varphi_i(r) =  \phi(r-r_i) /Z(r)$.
+
+
+\vfill\eject
+
+
+\beginsection 2.6 The ``$L$ neighbors naive interpolation''
+
+The numerical  implementation of the above ``unique weight''  interpolation
+is simple to code, but it costs of order $N$ operation for each   point $r$
+where the value of $f(r)$ is  calculated.  In order to save computing time
+this interpolation can be approximated  or mimiced by what I call the
+``naive method of order $L$'':
+$$
+f(r)={1\over Z(r)}   \sum_{m\in I(r)}  a_i \; \phi(r-r_m)
+\eqno(2.9)
+$$
+where $I(r)=\{ i_1(r), i_2(r), ..., i_L(r) \}  $ is the set containing the 
+indices of the  $L$ closest neighbors of $r$. The function $Z(r)$ ensures,
+as usual, that the sum of the weights is one, and is here:
+ $$
+Z(r)=  \sum_{m\in I(r)}   \phi(r-r_m)
+\eqno(2.10)
+$$
+This function should also be worth graphic plots for various choices of the  
+integer $L$ and the  variance of $\phi$ ($\sigma$ for the gaussian).
+
+
+
+\medskip
+
+This  ``naive interpolation'' can also be expressed  under the form (2.1),
+with 
+$$
+\varphi_i(r) =\left\{\matrix{   \phi(r-r_m)/Z(r) \qquad \hbox{if} \quad
+r \in  S^L_j  \cr
+0  \qquad \qquad \hbox{elsewhere}} \right.   
+\eqno(2.11)
+$$
+where $S_j^L$   is the   domain of all the points $r$ which admit the grid
+point $r_j$ in the list  of the $L$ closest neighbors.  The values at the
+boundary has to be adjusted as for the ``closest neighbor'' interpolation,
+which   is the particular case $L=1$ and $\phi=1$.
+
+
+
+
+
+
+
+\beginsection 3. GRID-TO-GRID INTERPOLATION
+
+There is a big difference between the interpolation from a set of data on a
+grid to a function $f(r)$ defined everywhere, and a grid-to-grid
+interpolation. In a grid-to-grid interpolation, a set of data is given on a
+first grid, the ``source grid'', and the interpolation must generate from
+these a set of data on a new grid, the ``target grid''. This  problems occurs
+in the ocean-atmosphere coupling problem where fluxes must be transmitted
+from the atmospheric grid to the oceanic grid, and sea surface temperature
+(SST) 
+from the oceanic grid to  the atmospheric grid. 
+ Of course, given an interpolation  on the source grid, one can apply the
+interpolated function $f(r)$ at each point of the target grid to define a
+grid-to-grid interpolation. But this choice can be extended through a
+Lagrangian formalism where the grid-to-grid interpolation depends on an
+interpolation on the source grid and also an interpolation of the target
+grid. Indeed the grid-to-grid interpolation depends on what the physicist
+intends to do with the interpolated values, and this can generally be
+expressed through the definition of an interpolation on the target grid. 
+These considerations will guide the choices of the parameters of our ``naive''
+grid-to-grid interpolation (number of neighbors and variance).  
+
+\vfill\eject
+
+
+\beginsection 3.1 Sea domains and Ocean-Atmosphere coupling
+
+The grid of an Atmospheric General Circulation Model (AGCM)  is made  of
+``land points'' and ``sea points''. The grid of an Oceanic General Circulation
+Model (OGCM)  is, by definition, only made of ``oceanic points''.  The AGCM
+``sea points''  and the OGCM ``oceanic points''  generally do not coincide,
+except  when the same grids  has been chosen. 
+
+
+
+The fluxes of the AGCM are known at all  the points, land or sea, and one of
+ the 
+task of the coupler is to interpolate them for  the OGCM grid. 
+This can be done
+either by using all the  grid,  with no distinction between land and sea
+points, or only taking into account the sea points. This last point is still
+under debate.  There is no such a choice
+however when passing the sea surface temperature (SST) of the OGCM  grid
+to the AGCM ``sea points''.
+
+
+
+In all these cases, it is possible to denote by  by $(r^a_i),\; i=1,N^a$ the
+``source grid'' on which are known the data and $(r^b_i),\; i=1,N^b$ the
+``target grid'' on which the interpolated values must be calculated.  The
+two domains of the two grids are likely to  have  a large intersection and
+sometimes a not so small differences (the complementary of  the
+intersection in the reunion of the the two domains).  The influence of the 
+difference set of the two grids in a grid-to-grid interpolation  will be
+investigated in Part B of this letter,  through numerical tests. 
+
+
+
+\beginsection 3.2  Lagrangian formalism
+
+A grid-to-grid interpolation always assumes, even  if  not said, the
+choice of an interpolation  on the  source  grid as well as on the target
+grid.  
+
+
+
+Let 
+$$
+f(r)=\sum_{i=1}^{N^a} a_i \varphi_i(r) 
+\eqno(3.1)
+$$
+a chosen interpolation on the source grid A defined by the points $(r^a_i),\;
+i=1,N^a$,  at which the values $a_i$ are known. 
+
+
+
+Let 
+$$
+g(r)=\sum_{j=1}^{N^b} b_i \psi_j(r) 
+\eqno(3.2)
+$$
+a chosen interpolation on the target grid B defined by the points $(r^b_i),\;
+j=1,N^b$,  at which the values $b_i$ are unknown an to be calculated
+through a grid-to-grid interpolation.  
+
+
+
+Such a grid-to-grid interpolation can be defined by the minimization of
+the Lagrangian:
+$$
+L(b_1, b_2, ..., b_{N^b}) =  \int [f(r)-g(r)]^2  dr \;.
+\eqno(3.3)
+$$
+The integral is on all the domain, owing the fact that the $
+\varphi_i(r)$'s can be zero outside their support. 
+It is natural to minimize this Lagrangian  in order to  have $f(r)$ as close
+as possible of $g(r)$. 
+The set of coefficients $(b_j),\; j=1,N^b$ which  realizes this minimization
+is found by saying that all the partial derivatives $\partial L / \partial
+b_j$ vanish. Some straightforward algebraic manipulations show that this
+lead the  $N^b$ linear equations:
+$$
+2 \sum_{j=1}^{N^b}  < \psi_m | \psi_j > b_j 
+=2 \sum_{i=1}^{N^a}  < \psi_m | \varphi_i> a_i 
+\qquad \hbox{for} \quad m=1,N^b
+\eqno(3.4)
+$$
+where 
+$$
+  < \psi_m  |\psi_j > = \int    \psi_m (r)\psi_j(r) dr  =:  V_{mj}
+\eqno(3.5) 
+$$
+and 
+$$
+  < \psi_m |  \varphi_i > = \int    \psi_m (r)\varphi_i(r) P(r) dr  =:  U_{mi}
+\;.
+\eqno(3.6) 
+$$
+
+
+
+In order to find the $N^b$ values $b_j$'s, one has to invert the linear
+system $VB =  UA$:
+$$
+\sum_{j=1}^{N_b} V_{ml}\;  b_j =   \sum_{i=1}^{N_a}  U_{mi}\;  a_i
+\qquad\hbox{for}\quad m=1,N^b
+\eqno(3.7)
+$$
+
+
+
+The inversion of the $N_b$ x $N_b$  matrix $V$ is  possible if  the
+$\psi_j$'s are a good basis, and the grid-to-grid interpolation finally
+reads: $B=V^{-1}U    A$. 
+
+
+
+
+
+\beginsection 3.3 The choice of the two grid interpolations
+
+
+
+Choosing the ``closest neighbor'' interpolation for the target grid, in the
+above formalism,  lead to a very easy implementation of the method because
+the matrix $V$ is equal to  unity.  The interpolation chosen on the source
+grid (grid A) is  then the  only one  which determines the grid-to-grid
+interpolation and reads:
+$$
+b_j= \sum _{i=1}^{N^a}  a_i  \overline{\varphi_i}^{S_j}(r_j^b)
+\eqno(3.8)
+$$
+where
+$$
+\overline{\varphi_i}^{S_j}(r_j^b)=  \int_{S_j} \varphi_i(r)
+\eqno(3.9)
+$$
+is the  average of   $\varphi$ on the  ``closest neighbor'' cell surrounding
+$r_j$.  When the variance of $\varphi_i$ is large compared to the size of
+this  domain,  this average is close to its value at $r_j$ and we have 
+approximatively $b_j\sim f(r_j)$.  On the contrary, if  this variance is 
+small compared  to the size of the ``closest neighbor''  cells of the  target
+grid (grid B),  the grid-to-grid interpolation is approximatively the trivial
+interpolation for which all the $b_j$'s are equal to the mean value 
+$\sum_i a_i$.
+
+
+
+
+\bigskip
+
+
+Having this in  mind, I want to express here some  intuitive  ideas  about
+the choice of the source and target grid interpolation, when building a
+grid-to-grid interpolation with the above Lagrangian formalism. Let us
+consider three situations.
+
+\medskip
+
+
+
+\item{*} {\bf  Coarse to thin grid}. If the source grid A is coarser that the 
+target grid B, it seems natural  to choose the ``closest neighbor''
+interpolation on grid B. On grid A, one feels that  an smooth interpolation 
+with an ``overlap order'' which is be 2 or 5 times
+ to the thinest ratio of the
+two grids, i.e., the ratio of the average mesh size  of the coarse grid A over
+the average mesh size  of the thin grid B. 
+
+\medskip
+
+ \item{*} {\bf Thin to coarse grid}. It the source grid A is thiner that the 
+target grid B. One can still try to choose the ``closest neighbor''
+interpolation on grid B. 
+On grid A, one feels that  an smooth interpolation  with an ``overlap order''
+which is roughly equal to the coarsest ration of the two grid, i.e., the ratio
+of the average mesh size  of the thin grid A over the average mesh size  of
+the coarse grid B. 
+
+
+
+
+
+\beginsection 3.4 The grid-to-grid  ``naive'' method
+
+All the above considerations have been addressed in order to explain the 
+grid-to-grid  ``naive'' method that is  being build as a temporary  modulus, 
+waiting for a  less naive  method  to be coded. 
+
+
+
+In this naive method the fluxes $b_j$ on the ocean grid B $(r^b_j),\;  j=1,N^b$ 
+are  obtained  from the fluxes $a_i$ of the atmospheric grid A $(r^a_i),\;
+i=1,N^a$  simply by applying the $L^a$ neighbors $\sigma_a$-gaussian
+interpolation with :
+ $$
+b_j={1\over Z^a(r^b_j)}   \sum_{m\in I(r^b_j)}  a_i  e^{-{(r^b_j-r^a_m)^2
+\over 2 \sigma_a^2} }
+\eqno(3.10)
+$$
+where $I(r^b_j)=\{ i_1(r^b_j), i_2(r^b_j), ..., i_{L^a}(r^b_j) \}  $ is the set
+containing the  indices of $L^a$ closest neighbors A-grid points $r^a_m$
+of the B-grid point $r^b_j$, and   
+$$
+Z^a(r^b_j) =  \sum_{m\in I(r^b_j)}   e^{-{(r^b_j-r^a_m)^2 \over 2
+\sigma_a^2} }\;.
+\eqno(3.11)
+$$
+
+
+
+\medskip
+
+When interpolating the SST (sea surface  temperature) for the oceanic grid 
+B to the atmospheric grid, the same principle is applied with 
+the $L^b$ neighbors $\sigma_b$-gaussian interpolation:
+ $$
+a_i={1\over Z^b(r^a_i)}   \sum_{m\in J(r^a_i)}  b_i  e^{-{(r^a_i-r^b_m)^2
+\over 2 \sigma_b^2} }
+\eqno(3.12)
+$$
+where $J(r^a_i)=\{ j_1(r^a_i), j_2(r^a_i), ..., i_{L^b}(r^a_i) \}  $ is the set
+containing the  indices of $L^b$ closest neighbors B-grid points $r^b_m$
+of the A-grid point $r^a_i$, and
+$$   
+Z^b(r^a_i) =  \sum_{m\in J(r^a_i)}   e^{-{(r^a_i-r^b_m)^2 \over 2
+\sigma_b^2} }
+\eqno(3.13)
+$$
+
+\vfill\eject
+
+
+\bigskip 
+
+The adjustable parameters of this ``naive method'' are the two integers
+$L^a$ and $L^b$ and the two variances $\sigma_a$ and $\sigma_b$.  For a
+given couple of grids A and B, their choice can be guided by the above 
+analysis base on the Lagrangian formalism. 
+
+
+
+If Grid B is thiner than Grid A, which is the case for the
+Ocean-Atmosphere coupling, it is reasonable to choose $L^a$ or order 10
+and $\sigma_a$ of the order of the average mesh of grid A. In the  above
+formalism of the Lagrangian interpolation, this choice corresponds to 
+the $L^a$ neighbors $\sigma_a$-gaussian interpolation on Grid A,  i.e.,
+and the ``delta-comb'' interpolation on Grid B, i.e., the choice of delta
+function for the $\psi_j$'s.  The inverse Grid B to Grid A interpolation can
+be expressed the same way, but with a different choice of $L^b$. Indeed, it
+seems natural to choose $L^b$ such that $L^b/L^a$ is of the order of the
+ratio between the A-grid and B-grid average mesh size, and $\sigma_b$ of
+the order of $\sigma_a$. With this choice a composition between a A to B
+and B to A grid interpolation is close to the Identity, which is a reasonable
+criteria to impose when no other information is assumed on the nature of
+the fields to be interpolated. 
+
+
+
+
+
+
+
+\beginsection 4. TOWARD A LESS NAIVE METHOD
+
+For the case of Ocean-Atmosphere coupling, information is known about
+the structure of the flux or SST fields to interpolated, and about the
+geometry of the   grid. The naive method should be thus replaced by
+grid-to-grid interpolations adapted to the specific physical problem of the
+Ocean-Atmosphere coupling. These interpolation have to be  tuned in order
+to answer specific quality criteria, imposed by physical arguments.  This
+tuning can be achieved through the choice of the basis functions  the
+source grid interpolation (the Atmospheric grid when passing fluxes, and
+the Oceanic one when passing the SST).  Constraints like the conservation
+of the global integral of fluxes can be satisfied by adding Lagrange
+multipliers in the Lagrangian  formalism. At last, a choice of the target
+grid  interpolation, different from the ``Dirac comb'' interpolation can be
+necessary. In this last case the inversion of the matrix $V$ of Equation
+(3.6) has to be done once for all, and the multiplication by $V^{-1}$, which
+is generally not sparse, has to  be performed for each new field to be
+interpolated.  The numerical computation of the elements of $U$ by
+Monte-Carlo techniques is briefly discussed.  
+
+
+
+\beginsection 4.2 Inhomogeneous and anisotropic interpolation
+
+The choice of the interpolation basis $\varphi^a_i(r)$ and $\varphi^b_j(r)$
+of the grid A and B considered as source grids (i.e. when interpolating
+fluxes or SST respectively), can be tuned in function of the geometry of
+the two grids, and the knowledge of the  physical structure of the fields to
+interpolate. For instance, some anisotropy could be given to these
+functions if the fields have a higher correlation in a particular direction
+(e.g. in latitudinal direction  on  the sphere).  Near the edges of the two
+grids, i.e. the costs, a special choice of the basis function, adapted to the
+geometry or the physical processes should be performed.  
+
+
+
+\beginsection 4.3 Lagrangian formalism with constraints
+
+When passing the flux of a quantity, like heat for instance, from the
+atmospheric grid to the oceanic grid it might be important to ensure that
+the amount of  the heat lost by the AGCM is  equal to the heat received by
+the OGCM.  This conservation can be implemented by imposed one  or
+several constraints in the definition of the interpolation. 
+
+
+
+Taking the notation of the Langragian formalism of Section 3, the
+constraints 
+$$
+\int f(r) dr = \int g(r) dr
+\eqno(4.1)
+$$
+defines a new grid-to-grid  interpolation  obtained by minimizing
+$$
+L(b_1, b_2, ..., b_{N^b})
+ =  \int [f(r)-g(r)]^2  dr + \lambda \int [f(r)-g(r)]  dr
+\eqno(4.2)
+$$
+where $\lambda$ is a Lagrangian multiplier. 
+
+
+
+With this constraint, Equation (3.4) is now replaced by the system
+$$
+\left\{
+\eqalign{ 
+ 2 \sum_{j=1}^{N^b}  < \psi_m | \psi_j > b_j 
+=&2 \sum_{i=1}^{N^a}  < \psi_m | \varphi_i> a_i - \lambda < \psi_m | 1 > 
+ \qquad \hbox{ for all } \quad m=1,N^b \cr
+ \sum_{j=1}^{N^b}
+  < \psi_j | 1 > b_j  =&  \sum_{i=1}^{N^a}  < \varphi_i | 1 >
+a_i
+} \right. 
+\eqno(4.3)
+$$
+where 
+$$
+< \psi_j | 1 > = \int \psi_j dr = : H_j
+\eqno(4.4) 
+$$
+and 
+$$
+< \varphi_i | 1 > = \int \varphi_i dr = : G_j
+\eqno(4.4) 
+$$
+
+Equation (3.7) is now replaced by a system $VB=UA-\lambda H$ with $HB=
+GA$:
+$$
+\left\{
+\eqalign{
+\sum_{j=1}^{N_b} V_{ml}\;  b_j =&   \sum_{i=1}^{N_a}  U_{mi} \; a_i - \lambda 
+G_m
+\qquad\hbox{for}\quad m=1,N^b  \cr
+\sum_{j=1}^{N^b}  H_j \; b_j  =&  \sum_{i=1}^{N^a}  G_i\; a_i 
+}\right.
+\eqno(4.5)
+$$
+
+
+
+This system is solved by first inverting the matrix $V$, which leads to the
+system $B=V^{-1}UA-\lambda V^{-1}H$ with $HB= GA$, and by
+eliminating $\lambda$. Let us denote $B^*= V^{-1}UA$, which is  the value
+of the coefficients that would be obtained without the constraint, and plug
+$B=B^*- \lambda V^{-1}H$ in the second equation. This gives the value of
+the Lagrange multiplier 
+$$
+\lambda= { H B^* - G A \over G V^{-1}H} \;
+\eqno(4.6)
+$$
+which gives a measure of how strongly the constraint is violated by the first
+guess $B^*$. This violation error is redistributed in the solution of the
+problem:
+$$
+\eqalign{
+B=& B^* - {H B^* - G A \over H V^{-1}H} V^{-1}H  \cr
+=& V^{-1}UA - {H V^{-1}UA - G A \over H V^{-1}H} V^{-1} H   \;.}
+\eqno(4.7)
+$$
+
+
+
+
+
+\beginsection 4.3 Practical considerations
+
+For the practical implementation of the interpolation methods which are
+derived from a Lagrangian formalism, one needs to know the numerical
+values of the quantities $V_{mj}=~~~<\psi_m | \psi_j> $,  $U_{mi}=  <\psi_m |
+\phi_i> $,   $H_m= <\psi_m | 1> $ and $G_i= <\varphi_i | 1> $. Even for the
+next neighbor interpolation basis, the numerical evaluation of these
+numbers is not straightforward. The complexity of this problem, however,
+do not exceed the one of the determination of the double integral  of an
+arbitrary function, which is an often encountered problem in physics. 
+Various methods can be found depending of the particular situation. 
+
+
+One of them is the evaluation of these integrals through Monte-Carlo
+techniques. For instance, if the functions $\psi_m$'s are the next neighbor 
+interpolation basis, the $H_m$'s are the surfaces of the non-intersecting
+domains $S_m$'s (see Section 2.3). If the surfaces of the grid meshes are
+known,  and if the grid is not too distorted (in a sense to be defined later), 
+it is possible to reduce the number of random shootings. Inside each  grid
+mesh formed by the four grid points $r_1$, $r_2$, $r_3$ and $r_4$, one
+can choose at random, with  a uniform probability, a big number of points. 
+For each of these  points $r$, it is only necessary to calculate the four
+values $\psi_1(r)$, $\psi_2(r)$, $\psi_3(r)$ and $\psi_4(r)$, associated to
+the four grid points at the corners of the mesh,   provided that  the grid is
+not too much distorted (by definition).  If so, the random point has to be
+chosen uniformly on a surface larger than the considered mesh. The same
+algorithm can be apply for the calculation the the $U_{mi}$'s. If the
+$\varphi_i$'s are the basis function of the $L$-closest neighbors
+interpolation,  this algorithm can be generalized.
+
+\vfill\eject 
+
+\beginsection 5. CONCLUSION
+
+The goal of this letter was to expose the ``naive'' grid-to-grid 
+interpolation  method that I have coded for the interpolation black box of
+the coupler.  For each point of the target grid, the algorithm search for its
+$L$-closest neighbor and calculates weight coefficients through the
+evaluation of a 
+gaussian function. This has to be done once for all, given a couple of grid,
+the addressed and the weight coefficients being the only information to be
+stored.  If $L$ is not big, this storage is not huge, and  the number of
+operation is also reasonable.  Test of this methods with several type of 
+grids will be presented in Part B. 
+
+In fact, the rough exposition  of the method could have been done quite
+more shortly if this  had been the only  considered goal.  But  the different
+formalisms presented in this letter are candidate to provide a framework
+to the intuitive ideas that one often   generates when dealing with this
+interpolation problem.  It can also be useful to try to translate into these
+formalisms more complicated interpolation methods, and, if not possible, 
+to see which  of their features do not enter in this framework. 
+
+
+
+\bigskip
+
+\noindent {\bf Acknowledgments:}  I thank all the participants of the ``Adm
+\& Science Team Meeting'' of March 11th, for their  remarks which have
+useful for the drafting of  this letter. 
+
+
+
+\beginsection REFERENCES
+
+\def\ref{\parskip 12pt \leftskip 20pt \parindent -20pt} 
+\def\endref{\parskip 0pt \leftskip 0pt \parindent 20pt}
+
+
+
+\ref
+[1]
+O. THUAL, Gathering information for a coupler,
+ {\it Epicoa \ } {\bf 1009} (1991).
+
+
+
+[2]
+ L. TERRAY, A simple communication scheme between coupler and GCM's, 
+ {\it Epicoa \ } {\bf 0203}  (1992). 
+
+
+
+[3]
+N. H. BARTH,  A Conservative Scheme for Passing Variables Between
+Coupled Models of the Ocean an Atmosphere,
+ {\it Technical Report\ }, CERFACS (1992).
+
+
+
+[4] ``Appel d'id\'ees pour la cr\'eation du coupleur du mod\`ele
+ communautaire'', written by  L. Terray,  October 10th 1991. 
+
+
+
+\endref
+
+
+
+\end
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisgb.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisgb.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/anaisgb.tex	(revision 4775)
@@ -0,0 +1,775 @@
+ \magnification =\magstep1
+\count0=90
+%definitions
+
+%end of definitions
+
+
+\centerline{ Olivier Thual, June 30$^{\rm th}$ 1992}
+ \bigskip
+
+\centerline{\bf SIMPLE OCEAN-ATMOSPHERE INTERPOLATION.}  
+\centerline{\bf PART B: SOFTWARE IMPLEMENATION}
+
+
+\bigskip
+
+
+A set of FORTRAN subroutines constitutes an implementation the ``naive''
+grid-to-grid interpolation method which has been exposed in the previous
+Part A of this letter. This implementation  is tested  for  both idealized, 
+EMERAUDE or OPA  grids, masks and scalar fields.  These
+subroutines can  be used in the first version the ocean-atmosphere coupler. 
+
+
+
+
+
+\beginsection 1. INTRODUCTION 
+
+Coupling two atmospheric and  oceanic general circulation models (AGCM
+and OGCM) having two different grids and sea-land masks, requires the
+interpolation of fluxes from the atmosphere to the ocean grids and of the
+sea surface temperature (SST) in the reverse direction.  A simple method
+to perform these interpolations have been presented in the previous Epicoa
+Letter [1]  called ``Simple ocean-atmosphere interpolation. Part A: the method'' as a
+particular case of a more general class of interpolations based on
+optimization theory (Lagrangian formalism).   
+
+\medskip
+
+The name  of ``naive method'' which has been given to denote one of the simplest
+interpolation among this class,  comes from the motivations
+which have governed its implementation. It was designed with simplicity
+requirement and short deadlines in order to reach as quickly as possible a
+first version of an ocean-atmosphere coupler. A more ``sovarphisticated
+method'' is beeing studied in parallel by Norman BARTH [2]. This method
+imposes the conservation of the field integral on each mesh of the coarser
+grid, and requires, in order to satisfy these multiple constraints, the
+mutiplication by matrices of the coarser grid size square for each
+interpolation. 
+
+A lot of the concepts which are used in the ``naive method'', comes from
+the ones that are considered in the ``sovarphisticated method'' [3,2], but retain
+only the low cost ones. The coupler will offer the possibility of choosing
+between the ``naive'' or ``sovarphisticated'' methods, depending on various
+constraints (memory space, computer time, efficiency, accuracy, etc...).
+Other methods, like the one of Philippe DANDIN [4], will also be pluged into
+the coupler. 
+
+
+
+
+
+\medskip
+
+
+
+
+
+The ``naive method'' can be summarized in few words:  knowing the values
+of a field on a source grid, the values on a point of the target grid is
+calculated by summing the values if its $L$th closest neighbors, with a
+weight which quicky decreases with the interdistance. 
+
+
+
+\medskip
+
+In Section 2, I recall the definition of the ``naive method'' in a concise
+way. In Section 3, I briefly
+describe the ``naive method library'', which is  the set of FORTRAN
+subroutines that I have written to implement the method, and focus on the
+visible part of the  iceberg that the coupler will need to know.  Some basic
+tests of this method are presented,  showing that there is no trivial bug
+left.   
+
+
+
+
+
+
+
+
+
+\beginsection 2.  THE NAIVE METHOD
+
+In Part A of this letter [1] general considerations about  grid-to-grid
+interpolation have been presented, and a ``simple  ocean-atmosphere  method'' have be
+presented in this general framework. Here I only present the materials
+necessary to its implementation. 
+
+
+
+\beginsection 2.1 Interpolation without constraints (SST) 
+
+Let $(b_j), j=1,N^b$ be the SST (sea surface temperature) on the ocean grid
+B,  defined by the points $(r^b_j), j=1,N^b$. Only the umasked points are
+considered in this definition of the grids and the following formula.  The
+values $(a_i), i=1,N^a$ of the SST on the atmospheric grid A,   defined by
+the points $(r^a_i), i=1,N^a$, are  given, in the naive method, by:
+$$
+a_i={1\over Z^b( r^a_i)} \sum_{m\in J(r_i^a)} b_i \;
+\phi\left( {\left| r_j^b-r_i^a\right| \over \sigma_b } \right) 
+\eqno(2.1)\; ,
+$$
+where $J(r)=\{j_1(r),  j_2(r), ..., j_{L^b}(r)\}$ is the set containing the
+indices of the $L^b$ closest neighbors $r_m^b$ in grid B, of a point $r$
+located anywhere, and the normalizing function $Z^b$, defined for all  grids
+points of the gird A is:
+$$
+ Z^b( r^a_i)= \sum_{m\in J(r_i^a)}  
+\phi\left( {\left| r_j^b-r_i^a\right| \over \sigma_b } \right)  \; .
+\eqno(2.2)
+$$
+
+
+
+In its present implementation the weight function $\phi$ is a gaussian: 
+$$
+\phi(u) = e^{-u^2 \over 2} 
+\eqno(2.3) \;.
+$$
+
+The variance $ \sigma_b$ is of the order one or two times the average
+mesh size  of the grid B.  Other choices of the weight functions are
+discussed below. 
+
+
+
+
+
+
+
+
+
+
+
+\beginsection 2.2 Summary of the Lagrangian formalism
+
+As explained in Part A [1], the extension of the above grid-to-grid
+interpolation to an interpolation with constraints can be defined through a
+formalism in which a Lagrangian functionnal is to be minimized under
+these constraints. 
+
+
+
+In this formalism, both the source grid A (on which $N^a$ values $a_i$ are
+known) and the target grid B (on which $N^b$ values $b_i$ are to be found)
+are associated to an interpolation which reads:
+
+$$
+f(r)= \sum_{i=1}^{N^a} a_i \varphi_i(r) 
+\eqno(2.4)
+$$
+for grid  A, which is made of $N^a$ grid points,  and
+$$
+g(r)= \sum_{j=1}^{N^b} b_j \psi_j(r) 
+\eqno(2.5)
+$$
+for grid  B, which is made of $N^b$ grid points. 
+
+
+
+If we impose that the equality of the integrals of the two functions $f$
+and $g$ (fluxes) on the two respective domains that the two grids are
+covering,  a constrained interpolation method is defined by the
+minimization of the Lagrangian:
+$$
+L(b_1,b_2,...,b_{N^b}) = \int [f(r)-g(r)]^2  \; dr + 
+\lambda \int [f(r)-g(r)] \; dr  
+\eqno(2.6)
+$$
+subject to the constraints $ \int [f(r)-g(r)] \; dr =0$. 
+
+With the matrix notations  $B=(b_j)$, $A=(a_i)$, $H=(\int \psi_j dr)$, $G=(\int
+\varphi_i dr)$ and $V=(\int \psi_m \psi_j dr)$, where $i=1,N^a$ and $j$
+or $m=1,N^b$, the solution of the minimization of $L$, subject to the
+constraint $HB=GA$, is given by $B=B^*-\lambda
+V^{-1}H$, where  $B^*= V^{-1}UA$ is the solution without constraint and
+$\lambda$,  the Lagragian multiplicator,  is given by 
+$$
+\lambda= { HB^*-GA \over HV^{-1}H} 
+\eqno(2.7) \;. 
+$$
+
+
+
+The solution with constraints reads, in its final form
+$$
+\eqalign{
+B=& B^* -{ HB^* - GA \over HV^{-1}H }  V^{-1}H \cr
+=& V^{-1}UA- {HV^{-1}UA - GA\over HV^{-1}H} V^{-1}H }
+\eqno(2.8) \;. 
+$$
+(NB: this expression
+and Equation 2.6 gives the errata of Equations 4.4, 4.6 and 4.7 of the first
+version {\bf 0615}  of the  Part A
+of this letter, now revised [1]). 
+
+\beginsection 2.3 Interpolation with one constraint (Flux)
+
+The easiest implementation of the above interpolation with constraint is
+obtained when $V$ is the unity matrix, that is when the interpolation
+associated with the target grid is the ``closest neighbor'' interpolation
+(see Part A [1] for details). 
+
+
+
+The above naive method, combined with this global conservation constraint
+of the integrals over the two domains (total fluxes) read: 
+
+$$
+b_j=b^*_j - \lambda  h_j  
+\eqno(2.9)
+$$
+where the unconstrained solution is 
+$$
+b^*_j={1\over Z^a( r^b_j)} \sum_{m\in I(r_j^b)} a_i 
+\phi\left( {\left| r_i^a-r_j^b\right| \over \sigma_a } \right) 
+\eqno(2.10)\; ,
+$$ 
+and the Lagrangian multiplier is given by 
+$$
+\lambda =  {\sum_{j=1}^{N^b} h_j b^*_j -   \sum_{i=1}^{N^a} g_i a^*_i 
+\over  \sum_{j=1}^{N^b} h_j h_j  }
+\eqno(2.11) 
+$$
+where $I(r)=\{i_1(r),  i_2(r), ..., i_{L^b}(r)\}$ is the set containing the indices
+of the $L^a$ closest neighbors $r_m^a$ in grid A, of a point $r$ located
+anywhere, and the normalizing function $Z^a$, defined for all  grids points
+of the gird B is:
+$$
+ Z^a( r^b_j)= \sum_{m\in I(r_j^b)}  
+\phi\left( {\left| r_i^a-r_j^b\right| \over \sigma_a } \right)  \; .
+\eqno(2.12)
+$$
+
+
+
+In the above expressions, $h_j$ is the area of the grid B meshes (see Part
+A [1]) and 
+$$
+g_i= \int  {1\over Z^a( r)} \phi\left( {\left|r- r_i^a\right| \over \sigma_a
+}\right)\; dr
+\eqno(2.12)
+$$ 
+
+In the present implementation of the software, these coefficients have been
+approximated by the surface of the meshes, i.e., $g_i$ is 
+ the surface of the set of all the points which admit $r_i^a$ as their
+ closest neighbor.   This is as if the closest neighbor
+interpolation were chosen in the constraint, while another  interpolation is
+chosen in the quadratic term of the Lagrangain.
+ However, in the future evolution of the
+software, more elabored values of $g_i$ will be possible. 
+
+ 
+
+
+
+\vfill\eject
+
+
+
+
+
+
+
+
+
+\beginsection 3. IMPLEMENTATION OF THE METHOD
+
+The above method have been implemented through a set of FORTRAN subroutines
+which constitutes the  ``naive method library''. Some practical details 
+are given in view of its use in the  coupler, or for testing purposes.
+ A first set of basic tests
+is shown, and the future evolution of this library is hinted. 
+
+
+
+\beginsection 3.1 The ``naive method library''
+
+The directory
+ {\tt greenh@cerfacs.fr:/usr1/pub/numlab/naiv} contains a software
+environment and a set of subroutines constituting the current
+implementation of the ``naive'' grid-to-grid interpolation method.  These
+FORTRAN subroutines have been written following the DOCTOR norm [5, 6].
+A main program performs various tests of these subroutines, and give
+examples of the use of theses subroutines.  
+
+
+
+\bigskip
+
+
+
+The initialization of the grids, the masks and the fields is dependant of the
+atmospheric and oceanic GCMs to be coupled, and will communicated by
+them to the coupler independantly of the interpolation task. However, the
+present library also contains subroutines which generates academic grids,
+masks or fields for testing purposes, and, so far, the initialization of a
+128x64 EMERAUDE grid, a 228x94 OPA-Pacific grid and some EMERAUDE
+fluxes. Extension to other realistic grids for testing purposes are planned. 
+
+
+\beginsection 3.2 A first draft for a manual 
+
+ This library is written is such a way that  only a few items
+need to be visible from the coupler. The names of these subroutines 
+start with {\tt NA}. These high level subroutines call basic subroutines
+with, most of the time, 
+a name starting with  {\tt PL}.
+A very preliminary draft is given through the name of these
+subroutines.
+
+
+\medskip
+\medskip
+\noindent{\bf Include files} 
+ \medskip
+
+These are, at first, three include files containing the commons which
+describe the grids:
+
+
+
+\medskip
+
+\item{}{\tt NAGRA.H}, containing the common for the arrays of grid A (e.g.
+atmsopheric). 
+
+
+
+\medskip
+
+\item{}{\tt NAGRB.H}, containing the common for the arrays grid B (e.g.
+ocean). 
+
+
+
+\medskip
+
+\item{}{\tt NAGAB.H}, containing the commons for the weight arrays used
+in  the grid-to-grid interpolations. 
+
+
+
+\medskip
+\medskip
+\noindent{\bf Grid initializations subroutines} 
+ \medskip
+
+The two first sets of commons of {\tt NAGRA.H} and {\tt NABRB.H}, for grid
+A and grid B, can be initialized by the subroutines: 
+
+
+
+\medskip
+
+\item{} {\tt NAGRDA },  to initialize idealized  A grids.
+
+
+
+\medskip
+
+\item{} {\tt NAGRDB },  to initialize idealized  B grids.
+
+
+
+\medskip
+
+\item{} {\tt NAGMRO },  to initialize the A grid from the EMERAUDE
+128x64 global grid. 
+
+
+
+\medskip
+
+\item{} {\tt NAGOPA},  to initialize idealized  B grid from the OPA
+226x94 Pacific grid. 
+
+
+
+
+\medskip
+\medskip
+\noindent{\bf Interpolations subroutines} 
+ \medskip
+
+The last set of common, in {\tt NAGAB.H} are calculated in the subourtine: 
+
+\medskip
+
+\item{} {\tt NASET(amesh,bmesh)},
+ to initialize the weight arrays of the  interpolation, given the variances
+of the weight functions {\tt amesh} and  {\tt amesh}.   
+
+
+\medskip
+
+
+
+Once the three initialisations are done, the grid A to grid B, and  grid  B to
+grid A interpolations are  performed by the two subroutines:
+
+
+
+\medskip
+
+
+
+\item{} {\tt NASST(ssta,sstb)}, to interpolate a field from grid B to
+grid A without constraint
+(e.g. the SST). 
+
+\medskip
+
+\item{} {\tt NAFLUX(fluxb,fluxa)}, to interpolate a field from grid A to
+grid B while conserving
+its average between the two unmasked domains (e.g., fluxes). 
+
+\medskip
+\medskip
+\noindent{\bf Basic subroutines} 
+ \medskip
+
+These suboutines are called by the higher level subroutines, and need not to
+be known by the first time user:
+
+
+{\tt
+PLDIS2.f  PLGPRI.f  PLGRDU.f  PLQQT.f   PLSCAR.f  PLSST.f   PLVISU.f
+
+
+PLFLUX.f  PLGRDC.f  PLINS.f   PLRHAL.f  PLSORT.f  PLSTAT.f
+
+
+PLGAUS.f  PLGRDP.f  PLMASQ.f  PLRHO.f   PLSSPH.f  PLTMRO.f
+
+
+IMPR.f   IMPRI.f
+}
+
+\medskip
+\medskip
+\noindent{\bf Testing  subroutines} 
+ \medskip
+
+
+Examples of the use of these ``coupler-visible'' subroutines (with names
+starting by {\tt NA}), or of the ``basic'' subroutines (with names starting by PL)
+can be found in several test performing subroutines: 
+
+\medskip
+
+\item{} {\tt NATFX(fluxb,fluxa)}:
+ call {\tt NAFLUX} and visualizes the fields.
+
+\medskip
+
+\item{} {\tt NATST(ssta,sstb)}: call {\tt NASST} and visualizes the fields.
+
+\medskip
+
+\item{} {\tt NATES1(flda,fldb,fldaa)}: calls 
+{\tt NASST} and then {\tt NAFLUX}, visualizes the fields, and compares the
+intial and final fields.  
+
+\medskip
+
+\item{} {\tt NATES2(flda,fldb,fldaa)}:  calls
+  {\tt NAFLUX} and then {\tt NASST}, and compares the
+intial and final fields. 
+\medskip
+
+\item{} {\tt NATES3(flda,fldb,fldaa,kvisuo}: calls  
+  {\tt NAFLUX} and  then {\tt NASST} and visualizes the fields in a way that
+allows animations. 
+Typically, the influence of the variance of the weight functions can be
+studied with this subroutine, through animation of the error field. 
+
+\medskip
+\medskip
+
+These testing subroutines  assume
+that the grids and the interpolation coefficients have already been
+initialized. 
+
+
+
+\beginsection 3.3 Tests of the grid-to-grid interpolation
+
+Various tests have been performed to check that the library of subroutines of
+was free of trivial tests. However, systematic tests of the performance of
+the ``naive method'' and its sensibility to its adjustable parameters (shape
+and variance of the weight functions, number of neighbours, relative
+positions of the masks, ...) still remain to be done. 
+
+
+
+\medskip
+
+In the following tests, the weight function $\phi$
+ is a Gaussian, with a uniform
+variance on a given grid. 
+
+\medskip
+
+
+
+The most trivial test was to check that with a one neighbour interpolation,
+and the same grid, the interpolation was giving the same field.  
+
+
+
+\medskip
+
+
+
+The second test has been made with an analytically generated field $f(x,y)=$
+$\cos (k1 x)$ $\cos(k_2 y)$ interpolation  forward (NAFLUX) an backward
+(NASST) between a cartesian square grid and a polar disk grid, with
+non-coincident masks.  Figure show an example in which 
+ small neighbour number has been given
+to the naive method. This test shows that the original field is well
+recovered, excepted, of course, in the regions where the mask are far from
+coincidence. 
+
+\medskip
+
+
+
+
+
+The third test  uses two grids of very different resolutions, with a mask
+defined by an analytical curve.  The case of a circle  is shown on Figure 2,
+and more complex contour should be used in future tests of this kind. 
+
+\medskip
+
+
+
+
+
+The fourth test (Figure 3) studies the interpolation between an
+analytically defined field $f(x,y)$ on the masked EMERAUDE grid
+(Atmospheric GCM) and the unmasked Pacific OPA (Ocean GCM).   In the
+forward interpolation (NAFLUX), the trace of the EMERAUDE mask can be
+seen on the unmasked OPA domain. In the backward direction (NASST), the
+original field is well recovered  on the tropical Pacific, and, of course,
+meaninless far from this region. 
+
+
+
+The last test  (Figure 4) deals with a realistic flux field (stress $\tau_ x$
+in the longitudinal direction) of EMERAUDE and shows it interpolation on
+the Pacific OPA masked grid. Comparison with Philippe Dandin's
+interpolation's method is under progress.                        
+
+
+
+\beginsection 3.4 Future developments
+
+In the  present state of the ``naive method library'',
+ the coupler-visible items  are
+ready  to be used in the coupler. However, they are at the
+stage of a $\beta$-release, and will be improved by furthers tunings.  The
+possibility of choosing weight functions which shape and variance can vary
+with the index of the grid point will be given. This will allow, for instance, 
+to use ``non-smoothing'' function, e.g. the  functions associated to the
+spectral method used on the grid [7]. This will also allow   to pay special
+attention to land-sea regions, or  implement interpolation method based on
+``wavelet decomposition''.  
+
+
+
+%The calculation of the grid surface elements is not yet  properly
+%implemented for spherical grids. 
+
+
+
+\beginsection 4. CONCLUSION 
+
+The present letter can be considered as a first draft of a user manual of
+the ``naive method''. A concise presentation
+ of the  method has been presented, 
+as well ot its possible future evolution. Pratical details for the
+use of the ``naive method library'' have been given in the spirit of its
+integration into the coupler. The names of testing subroutines which can be 
+read as examples have been given. 
+
+
+
+Further steps need to be done in order to reach a clean version of this
+``naive method library'', with a more complete user manual. However, these
+first steps in the organisation of a sofware product, with the respect of
+the DOCTOR norm, the separation between  subroutines ``visible''  from a
+calling code, with a minimal list of argument and extensive use of
+commons, and  ``basic'' subroutines free of commons, can be helpfull  for
+the organization of our future software development. Such an organization
+is also found in the ``Spectral Interface Library'' [8]. 
+
+
+
+\beginsection  Acknowledgments 
+
+I thank Dominique ASTRUC for helping to use his visualization software [9]
+with which the Figure have been produced. 
+
+
+
+
+\beginsection REFERENCES
+
+
+\def\ref{\parskip 12pt \leftskip 20pt \parindent -20pt} 
+\def\endref{\parskip 0pt \leftskip 0pt \parindent 20pt}
+
+
+\ref
+
+[1]
+O. THUAL, Simple  ocean-atmosphere  interpolation. Part A: the method, 
+ {\it Epicoa \ } {\bf 0315}  (1992).
+
+
+
+[2] 
+N. H. BARTH,  A Conservative Scheme for Passing Variables Between
+Coupled Models of the Ocean an Atmosphere
+ {\it Technical Report \ }, CERFACS (1992).
+
+
+
+[3] 
+O. THUAL, Gathering information for a coupler,
+ {\it Epicoa \ } {\bf 0119} (1992).
+
+
+
+
+[4] 
+P. DANDIN, th\`ese de doctorat, in preparation (1992). 
+
+
+
+[5] J. CLOCHARD, Norme de codage ``DOCTOR'' pour le projet ARPEGE,{\it Note de
+travail ``AREPEGE''}  {\bf No. 4} (1988). 
+
+
+
+[6] J. K. GIBSON, The Doctor system - A DOCumentary ORiented programming
+system, {\it ECMWF Technical Memorandum}  {\bf No. 52} (1982). 
+
+
+[7] P. BERNARDET, private communication (1992).
+
+[8]  O. THUAL, Spectral Interfaces Library Version 2.2,  CERFACS (1990).
+
+
+[9]  D. ASTRUC,  Visuo: manuel de l'utilisateur, {\it Internal Report}
+(1990). 
+ 
+\endref
+
+
+\vfill\eject
+\centerline{ Exchange of Projects and Ideas for Coupling Ocean and
+Atmosphere (Epicoa)}
+\centerline{ Appendix to Olivier Thual(8) , June 30$^{\rm th}$ 1992}
+ \bigskip
+
+
+\centerline{\bf  SOURCE OF THE NAIVE METHOD LIBRARY}
+ \bigskip
+
+\centerline{ Version naiv01,  92 06 30 } 
+
+
+
+\bigskip \bigskip
+
+This version is contained in {\tt
+greenh@cerfacs.fr:/usr1/pub/numlab/naiv/cnaiv01}
+
+\bigskip \bigskip
+
+
+
+\beginsection 1. Include files
+
+{\tt
+
+NAGAB.H  NAGRA.H  NAGRB.H
+
+
+}
+
+\beginsection 2. Main Program
+
+
+
+{\tt
+
+ANAIV.f
+
+}
+
+
+
+\beginsection 3. Coupler visible subroutines {\tt NA - - - -} 
+
+
+
+{\tt
+
+NAFLUX.f  NAGMRO.f  NAGRA.H   NAGRDA.f  NASET.f   NATES1.f  NATES3.f  NATST.f
+
+
+NAGAB.H   NAGOPA.f  NAGRB.H   NAGRDB.f  NASST.f   NATES2.f  NATFX.f
+
+
+
+}
+
+
+
+\beginsection 4. Basic  subroutines {\tt PL - - - -} 
+
+
+
+{\tt
+
+PLDIS2.f  PLGPRI.f  PLGRDU.f  PLQQT.f   PLSCAR.f  PLSST.f   PLVISU.f
+
+
+PLFLUX.f  PLGRDC.f  PLINS.f   PLRHAL.f  PLSORT.f  PLSTAT.f
+
+
+PLGAUS.f  PLGRDP.f  PLMASQ.f  PLRHO.f   PLSSPH.f  PLTMRO.f
+
+
+
+
+}
+
+
+
+\beginsection 5. Subroutine stolen from outside 
+
+
+
+{\tt
+
+IMPR.f   IMPRI.f
+
+
+}
+
+
+
+\end
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/expdlist.sty
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/expdlist.sty	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/expdlist.sty	(revision 4775)
@@ -0,0 +1,176 @@
+%%
+%% This is file `expdlist.sty',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% expdlist.dtx  (with options: `style')
+%% 
+%% This is a generated file.
+%% 
+%% Copyright 1992 1999 R. Huelse, W. Kaspar
+%% 
+%% This file is part of the expdlist package.
+%% ------------------------------------------
+%% 
+%% It can redistributed and/or modified under the terms
+%% of the LaTeX Project Public License Distributed from CTAN
+%% archives in directory macros/latex/base/lppl.txt; either
+%% version 1 of the License, or (at your option) any later version.
+%% 
+\def\filename{EXPDLIST}
+\def\filedate{22.09.1999}
+\def\fileversion{V 2.4}
+\def\docdate {22.09.99}
+%% \CheckSum{214}
+%% \CharacterTable
+%%  {Upper-case    \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
+%%   Lower-case    \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
+%%   Digits        \0\1\2\3\4\5\6\7\8\9
+%%   Exclamation   \!     Double quote  \"     Hash (number) \#
+%%   Dollar        \$     Percent       \%     Ampersand     \&
+%%   Acute accent  \'     Left paren    \(     Right paren   \)
+%%   Asterisk      \*     Plus          \+     Comma         \,
+%%   Minus         \-     Point         \.     Solidus       \/
+%%   Colon         \:     Semicolon     \;     Less than     \<
+%%   Equals        \=     Greater than  \>     Question mark \?
+%%   Commercial at \@     Left bracket  \[     Backslash     \\
+%%   Right bracket \]     Circumflex    \^     Underscore    \_
+%%   Grave accent  \`     Left brace    \{     Vertical bar  \|
+%%   Right brace   \}     Tilde         \~}
+%%
+
+\typeout{Document Substyle `EXPDLIST'.
+         Released \filedate \space (\fileversion)}
+\typeout{English Documentation \space \docdate}
+\def\compact%
+   {\setlength{\itemsep}{-\parsep}}
+\def\setleftmargin%
+   #1%
+   {\setlength{\leftmargin}{#1}}
+\let\setlabelsize = \setleftmargin
+\def\setlabelphantom%
+   #1%
+   {\def\set@labelphantom%
+     {\setbox\@tempboxa=\hbox spread \labelsep {\@labelstyle #1\hfil}%
+      \setleftmargin{\wd\@tempboxa}%
+     }%
+   }
+\def\set@labelphantom{}
+\def\@labelstyle%
+   {\bfseries}
+\def\setlabelstyle%
+   #1%
+   {\def\@labelstyle{#1}}
+\def\breaklabel%
+   {\def\@breaklabel%
+       {\rule{0mm}{0mm}%
+        \\%
+       }%
+   }%
+\def\@breaklabel%
+   {}
+\let\@orgdlist\description
+\def\description%
+   {\@ifnextchar[%
+       {\@expdlist}%
+       {\@orgdlist}%
+   }
+\let\enddescription\endlist
+\def\@expdlistlabel#1%
+    {\@labelstyle
+     #1%
+     \hfil%
+    }
+\def\@expdlist[#1]%
+    {\list{}%
+      {\def\@breaklabel{}%
+       \def\set@labelphantom{}%
+       \def\@labelstyle{\bfseries}%
+       #1%
+       \set@labelphantom%
+       \setlength{\labelwidth}{\leftmargin}%
+       \addtolength{\labelwidth}{-\labelsep}%
+       \let\makelabel\@expdlistlabel%
+      }%
+    }
+\newlength{\listpartsep}
+\listpartsep = 1ex
+\long\def\listpart%
+   #1%
+   {\vspace{\listpartsep}%
+    \item[]\hspace*{-\leftmargin}%
+    \@tempskipa=\linewidth%
+    \addtolength{\@tempskipa}{\rightmargin}%
+    \addtolength{\@tempskipa}{\leftmargin}%
+    \parbox{\@tempskipa}{#1}%
+    \vspace{\listpartsep}%
+   }
+\def\@item[#1]{%
+  \if@noparitem
+    \@donoparitem
+  \else
+    \if@inlabel
+      \indent \par
+    \fi
+    \ifhmode
+      \unskip\unskip \par
+    \fi
+    \if@newlist
+      \if@nobreak
+        \@nbitem
+      \else
+        \addpenalty\@beginparpenalty
+        \addvspace\@topsep
+        \addvspace{-\parskip}%
+      \fi
+    \else
+      \addpenalty\@itempenalty
+      \addvspace\itemsep
+    \fi
+    \global\@inlabeltrue
+  \fi
+  \everypar{%
+    \@minipagefalse
+    \global\@newlistfalse
+    \if@inlabel
+      \global\@inlabelfalse
+      {\setbox\z@\lastbox
+       \ifvoid\z@
+         \kern-\itemindent
+       \fi}%
+      \box\@labels
+      \penalty\z@
+    \fi
+    \if@nobreak
+      \@nobreakfalse
+      \clubpenalty \@M
+    \else
+      \clubpenalty \@clubpenalty
+      \everypar{}%
+    \fi}%
+  \if@noitemarg
+    \@noitemargfalse
+    \if@nmbrlist
+      \refstepcounter\@listctr
+    \fi
+  \fi
+  \sbox\@tempboxa{\makelabel{#1}}%
+  \global\setbox\@labels\hbox{%
+    \unhbox\@labels
+    \hskip \itemindent
+    \hskip -\labelwidth
+    \hskip -\labelsep
+    \ifdim \wd\@tempboxa >\labelwidth
+      \box\@tempboxa
+      \gdef\set@break{\@breaklabel}     % RUM Change 2.3.90
+    \else
+      \hbox to\labelwidth {\unhbox\@tempboxa}%
+      \gdef\set@break{}%                % RUM Change 2.3.90
+    \fi
+    \hskip \labelsep}%
+    \set@break                          % RUM Change 2.3.90
+  \ignorespaces}
+\endinput
+%%
+%% End of file `expdlist.sty'.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/fancyheadings.sty
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/fancyheadings.sty	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/fancyheadings.sty	(revision 4775)
@@ -0,0 +1,205 @@
+% fancyheadings.sty version 1.98
+% Fancy headers and footers.
+% Piet van Oostrum, Dept of Computer Science, University of Utrecht
+% Padualaan 14, P.O. Box 80.089, 3508 TB Utrecht, The Netherlands
+% Telephone: +31 30 2531806. Email: piet@cs.ruu.nl
+% Sep 16, 1994
+% version 1.4: Correction for use with \reversemargin
+% Sep 29, 1994:
+% version 1.5: Added the \iftopfloat, \ifbotfloat and \iffloatpage commands
+% Oct 4, 1994:
+% version 1.6: Reset single spacing in headers/footers for use with
+% setspace.sty or doublespace.sty
+% Oct 4, 1994:
+% version 1.7: changed \let\@mkboth\markboth to
+% \def\@mkboth{\protect\markboth} to make it more robust
+% Dec 5, 1994:
+% version 1.8: corrections for amsbook/amsart: define \@chapapp and (more
+% importantly) use the \chapter/sectionmark definitions from ps@headings if
+% they exist (which should be true for all standard classes).
+% May 31, 1995:
+% version 1.9: The proposed \renewcommand{\headrulewidth}{\iffloatpage...
+% construction in the doc did not work properly with the fancyplain style. 
+% June 1, 1995:
+% version 1.91: The definition of \@mkboth wasn't restored on subsequent
+% \pagestyle{fancy}'s.
+% June 1, 1995:
+% version 1.92: The sequence \pagestyle{fancyplain} \pagestyle{plain}
+% \pagestyle{fancy} would erroneously select the plain version.
+% June 1, 1995:
+% version 1.93: \fancypagestyle command added.
+% Dec 11, 1995:
+% version 1.94: suggested by Conrad Hughes <chughes@maths.tcd.ie>
+% CJCH, Dec 11, 1995: added \footruleskip to allow control over footrule
+% position (old hardcoded value of .3\normalbaselineskip is far too high
+% when used with very small footer fonts).
+% Jan 31, 1996:
+% version 1.95: call \@normalsize in the reset code if that is defined,
+% otherwise \normalsize.
+% this is to solve a problem with ucthesis.cls, as this doesn't
+% define \@currsize. Unfortunately for latex209 calling \normalsize doesn't
+% work as this is optimized to do very little, so there \@normalsize should
+% be called. Hopefully this code works for all versions of LaTeX known to
+% mankind.  
+% April 25, 1996:
+% version 1.96: initialize \headwidth to a magic (negative) value to catch
+% most common cases that people change it before calling \pagestyle{fancy}.
+% Note it can't be initialized when reading in this file, because
+% \textwidth could be changed afterwards. This is quite probable.
+% We also switch to \MakeUppercase rather than \uppercase and introduce a
+% \nouppercase command for use in headers. and footers.
+% May 3, 1996:
+% version 1.97: Two changes:
+% 1. Undo the change in version 1.8 (using the pagestyle{headings} defaults
+% for the chapter and section marks. The current version of amsbook and
+% amsart classes don't seem to need them anymore. Moreover the standard
+% latex classes don't use \markboth if twoside isn't selected, and this is
+% confusing as \leftmark doesn't work as expected.
+% 2. include a call to \ps@empty in ps@@fancy. This is to solve a problem
+% in the amsbook and amsart classes, that make global changes to \topskip,
+% which are reset in \ps@empty. Hopefully this doesn't break other things.
+% May 7, 1996:
+% version 1.98:
+% Added % after the line  \def\nouppercase
+% BY THE WAY, THIS IS THE LAST RELEASE OF VERSION 1.
+
+\let\fancy@def\gdef
+\def\lhead{\@ifnextchar[{\@xlhead}{\@ylhead}}
+\def\@xlhead[#1]#2{\fancy@def\@elhead{#1}\fancy@def\@olhead{#2}}
+\def\@ylhead#1{\fancy@def\@elhead{#1}\fancy@def\@olhead{#1}}
+
+\def\chead{\@ifnextchar[{\@xchead}{\@ychead}}
+\def\@xchead[#1]#2{\fancy@def\@echead{#1}\fancy@def\@ochead{#2}}
+\def\@ychead#1{\fancy@def\@echead{#1}\fancy@def\@ochead{#1}}
+
+\def\rhead{\@ifnextchar[{\@xrhead}{\@yrhead}}
+\def\@xrhead[#1]#2{\fancy@def\@erhead{#1}\fancy@def\@orhead{#2}}
+\def\@yrhead#1{\fancy@def\@erhead{#1}\fancy@def\@orhead{#1}}
+
+\def\lfoot{\@ifnextchar[{\@xlfoot}{\@ylfoot}}
+\def\@xlfoot[#1]#2{\fancy@def\@elfoot{#1}\fancy@def\@olfoot{#2}}
+\def\@ylfoot#1{\fancy@def\@elfoot{#1}\fancy@def\@olfoot{#1}}
+
+\def\cfoot{\@ifnextchar[{\@xcfoot}{\@ycfoot}}
+\def\@xcfoot[#1]#2{\fancy@def\@ecfoot{#1}\fancy@def\@ocfoot{#2}}
+\def\@ycfoot#1{\fancy@def\@ecfoot{#1}\fancy@def\@ocfoot{#1}}
+
+\def\rfoot{\@ifnextchar[{\@xrfoot}{\@yrfoot}}
+\def\@xrfoot[#1]#2{\fancy@def\@erfoot{#1}\fancy@def\@orfoot{#2}}
+\def\@yrfoot#1{\fancy@def\@erfoot{#1}\fancy@def\@orfoot{#1}}
+
+\newdimen\headrulewidth
+\newdimen\footrulewidth
+\newdimen\plainheadrulewidth
+\newdimen\plainfootrulewidth
+\newdimen\headwidth
+\newdimen\footruleskip
+\newif\if@fancyplain \@fancyplainfalse
+\def\fancyplain#1#2{\if@fancyplain#1\else#2\fi}
+\headwidth=-123456789sp %magic constant
+
+% Command to reset various things in the headers:
+% a.o.  single spacing (taken from setspace.sty)
+% and the catcode of ^^M (so that epsf files in the header work if a
+% verbatim crosses a page boundary)
+% It also defines a \nouppercase command that disables \uppercase and
+% \Makeuppercase. It can only be used in the headers and footers.
+\def\fancy@reset{\restorecr
+ \def\baselinestretch{1}%
+ \def\nouppercase##1{{\let\uppercase\relax\let\MakeUppercase\relax##1}}%
+ \ifx\undefined\@newbaseline% NFSS not present; 2.09 or 2e
+   \ifx\@normalsize\undefined \normalsize % for ucthesis.cls
+   \else \@normalsize \fi
+ \else% NFSS (2.09) present
+  \@newbaseline%
+ \fi}
+
+% Initialization of the head and foot text.
+
+\headrulewidth 0.4pt
+\footrulewidth\z@
+\plainheadrulewidth\z@
+\plainfootrulewidth\z@
+\footruleskip .3\normalbaselineskip
+
+\lhead[\fancyplain{}{\sl\rightmark}]{\fancyplain{}{\sl\leftmark}}
+%  i.e. empty on ``plain'' pages, \rightmark on even, \leftmark on odd pages
+\chead{}
+\rhead[\fancyplain{}{\sl\leftmark}]{\fancyplain{}{\sl\rightmark}}
+%  i.e. empty on ``plain'' pages, \leftmark on even, \rightmark on odd pages
+\lfoot{}
+\cfoot{\rm\thepage} % page number
+\rfoot{}
+
+% Put together a header or footer given the left, center and
+% right text, fillers at left and right and a rule.
+% The \lap commands put the text into an hbox of zero size,
+% so overlapping text does not generate an errormessage.
+
+\def\@fancyhead#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\hbox
+{\rlap{\parbox[b]{\headwidth}{\raggedright#2\strut}}\hfill
+\parbox[b]{\headwidth}{\centering#3\strut}\hfill
+\llap{\parbox[b]{\headwidth}{\raggedleft#4\strut}}}\headrule}}#5}
+
+\def\@fancyfoot#1#2#3#4#5{#1\hbox to\headwidth{\fancy@reset\vbox{\footrule
+\hbox{\rlap{\parbox[t]{\headwidth}{\raggedright#2\strut}}\hfill
+\parbox[t]{\headwidth}{\centering#3\strut}\hfill
+\llap{\parbox[t]{\headwidth}{\raggedleft#4\strut}}}}}#5}
+
+\def\headrule{{\if@fancyplain\let\headrulewidth\plainheadrulewidth\fi
+\hrule\@height\headrulewidth\@width\headwidth \vskip-\headrulewidth}}
+
+\def\footrule{{\if@fancyplain\let\footrulewidth\plainfootrulewidth\fi
+\vskip-\footruleskip\vskip-\footrulewidth
+\hrule\@width\headwidth\@height\footrulewidth\vskip\footruleskip}}
+
+\def\ps@fancy{%
+\@ifundefined{@chapapp}{\let\@chapapp\chaptername}{}%for amsbook
+% Define \MakeUppercase for old LaTeXen.
+% Note: we used \def rather than \let, so that \let\uppercase\relax (from
+% the original documentation) will still work.
+\@ifundefined{MakeUppercase}{\def\MakeUppercase{\uppercase}}{}
+\@ifundefined{chapter}{\def\sectionmark##1{\markboth
+{\MakeUppercase{\ifnum \c@secnumdepth>\z@
+ \thesection\hskip 1em\relax \fi ##1}}{}}%
+\def\subsectionmark##1{\markright {\ifnum \c@secnumdepth >\@ne
+ \thesubsection\hskip 1em\relax \fi ##1}}}%
+{\def\chaptermark##1{\markboth {\MakeUppercase{\ifnum \c@secnumdepth>\m@ne
+ \@chapapp\ \thechapter. \ \fi ##1}}{}}
+\def\sectionmark##1{\markright{\MakeUppercase{\ifnum \c@secnumdepth >\z@
+ \thesection. \ \fi ##1}}}}%
+%\csname ps@headings\endcsname % use \ps@headings defaults if they exist
+\ps@@fancy
+\gdef\ps@fancy{\@fancyplainfalse\ps@@fancy}%
+% Initialize \headwidth if the user didn't
+\ifdim\headwidth<0sp
+% This catches the case that \headwidth hasn't been initialized and the
+% case that the user added something to \headwidth in the expectation that
+% it was initialized to \textwidth. We compensate this now. This loses if
+% the user intended to multiply it by a factor. But that case is more
+% likely done by saying something like \headwidth=1.2\textwidth The doc
+% says you have to change \headwidth after the first call to,
+% \pagestyle{fancy}. This code is just to catch the most common cases were
+% that requirement is violated.
+    \advance\headwidth123456789sp\advance\headwidth\textwidth\fi}
+\def\ps@fancyplain{\ps@fancy \let\ps@plain\ps@plain@fancy}
+\def\ps@plain@fancy{\@fancyplaintrue\ps@@fancy}
+\def\ps@@fancy{%
+\ps@empty % This is for amsbook/amsart, which do strange things with \topskip
+\def\@mkboth{\protect\markboth}%
+\def\@oddhead{\@fancyhead\@lodd\@olhead\@ochead\@orhead\@rodd}%
+\def\@oddfoot{\@fancyfoot\@lodd\@olfoot\@ocfoot\@orfoot\@rodd}%
+\def\@evenhead{\@fancyhead\@rodd\@elhead\@echead\@erhead\@lodd}%
+\def\@evenfoot{\@fancyfoot\@rodd\@elfoot\@ecfoot\@erfoot\@lodd}%
+}
+\def\@lodd{\if@reversemargin\hss\else\relax\fi}
+\def\@rodd{\if@reversemargin\relax\else\hss\fi}
+
+\let\latex@makecol\@makecol
+\def\@makecol{\let\topfloat\@toplist\let\botfloat\@botlist\latex@makecol}
+\def\iftopfloat#1#2{\ifx\topfloat\empty #2\else #1\fi}
+\def\ifbotfloat#1#2{\ifx\botfloat\empty #2\else #1\fi}
+\def\iffloatpage#1#2{\if@fcolmade #1\else #2\fi}
+
+\newcommand{\fancypagestyle}[2]{%
+  \@namedef{ps@#1}{\let\fancy@def\def#2\relax\ps@fancy}}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/go.csh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/go.csh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/go.csh	(revision 4775)
@@ -0,0 +1,4 @@
+#!/bin/csh 
+
+pdflatex oasis3mct_UserGuide.tex
+pdflatex oasis3mct_UserGuide.tex
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/oasis3mct_UserGuide.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/oasis3mct_UserGuide.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/oasis3mct_UserGuide.tex	(revision 4775)
@@ -0,0 +1,76 @@
+\documentclass[rs,english,toc,lot,lof,index,wide,overfull]{prismdoc}
+%====================================
+% PRISMDOC: Start Dokument Information
+%====================================
+%\usepackage{longtable}
+\usepackage{natbib}
+\usepackage{verbatim}
+\usepackage{epsfig}
+\usepackage{rotating}
+\usepackage{graphicx}
+\usepackage{amssymb}
+\usepackage{longtable}
+%
+% Specifications for cover pages: 
+
+\prismdocNum{}
+\prismdocTitel{{\fontsize{13}{16}\selectfont
+    OASIS3-MCT User Guide \\ [0.5ex]
+    \it{OASIS3-MCT\_2.0 }}}
+\prismdocAutor{Edited by:  \\ [0.5ex]
+            S. Valcke, T. Craig, L. Coquart  \\[0.5ex]
+            CERFACS/CNRS SUC URA No1875 \\[0.5ex]
+}
+\prismdocVersion{CERFACS TR/CMGC/13/17}
+\prismdocSName{Sophie Valcke}
+\prismdocFAff{CNRS}
+\prismdocSAff{CERFACS}
+%\prismdocFEM{toto}
+\prismdocFEm{oasishelp(at)cerfacs.fr} 
+\prismdocFName{Laure Coquart}
+\prismdocSPhone{}
+\prismdocFPhone{}
+%\prismdocFWp{wpnn}
+%\prismdocSWp{wpnn}
+\prismdocDate{May 2013}
+
+
+%====================================
+% PRISMDOC: End Dokument Information
+%====================================
+\newcommand{\antispace}{\vspace*{-2ex}}
+\newcommand{\bigspace}{\vspace*{+4ex}}
+\newcommand{\medspace}{\vspace*{+2ex}}
+\newcommand{\smallspace}{\vspace*{+0ex}}
+\newcommand{\marginlabel}[1]{\mbox{}\marginpar{\raggedleft\hspace{0pt}#1}}
+\newcommand{\imprt}{\marginlabel{{\bfseries\Huge !}}}
+\newcommand{\imprtbig}{\marginlabel{{\bfseries\Huge !}}}
+\newcommand{\bignote}{\marginlabel{{\bfseries\Huge !!!}}}
+\newcommand{\imprtsm}{\marginlabel{{\bfseries\LARGE !}}}
+\newcommand{\imnote}{\marginlabel{{\bfseries\LARGE !!!}}}
+\newcommand{\bcntr}{\begin{center}}
+\newcommand{\ecntr}{\end{center}}
+
+%\includeonly{documentation}
+\begin{document}
+%\setcounter{secnumdepth}{-1} 
+\prismdocHeader
+
+\include{defines}
+\include{UG_Acknowledgements}
+\include{UG0_Stepbystep_overview}
+%\include{UG1_Obtaining}
+\include{UG2_Model_interfacing}
+\include{UG3_Namcouple_generation}
+\include{UG4_Transformations}
+\include{UG5_Auxiliary_files}
+\include{UG6_Compilation_running}
+% > appendices
+\include{UGA1_Grid_description}
+\include{UGA4_changes}
+%\include{UGA2_SCRIP}
+%\include{UGA3_couplings}
+\include{UGA5_notinvolved}
+
+\include{UGRefs}
+\end{document}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/prismdoc.cls
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/prismdoc.cls	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/doc/prismdoc.cls	(revision 4775)
@@ -0,0 +1,825 @@
+
+%%
+%% This is file `prismdoc.cls'; there should be no need for modifications
+%%
+
+\def\fileversion{0.8}
+\def\filedate{2004/07/26}
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesClass{prismdoc}[2004/07/26 For all prismdoc manuals]
+\RequirePackage{ifthen}
+
+\newboolean{IsItaIB}\setboolean{IsItaIB}{false}
+\newboolean{IsItaRS}\setboolean{IsItaRS}{false}
+\newboolean{IsItaDOCU}\setboolean{IsItaDOCU}{false}
+\newboolean{IsItaZIK}\setboolean{IsItaZIK}{false}
+\newboolean{IsItaZHB}\setboolean{IsItaZHB}{false}
+\newboolean{OptSectoChap}\setboolean{OptSectoChap}{false}
+\newboolean{OptChaptoSec}\setboolean{OptChaptoSec}{false}
+\newboolean{OptToc}\setboolean{OptToc}{false}
+\newboolean{OptNoArabic}\setboolean{OptNoArabic}{false}
+\newboolean{OptIndex}\setboolean{OptIndex}{false}
+\newboolean{OptFigureList}\setboolean{OptFigureList}{false}
+\newboolean{OptTableList}\setboolean{OptTableList}{false}
+\newboolean{OptExampleList}\setboolean{OptExampleList}{false}
+\newboolean{OptProgramList}\setboolean{OptProgramList}{false}
+\newboolean{OptJobList}\setboolean{OptJobList}{false}
+\newboolean{OptOldFloat}\setboolean{OptOldFloat}{false}
+\newboolean{OptLow}\setboolean{OptLow}{false}
+\newboolean{OptWide}\setboolean{OptWide}{false}
+\newboolean{OptNocopy}\setboolean{OptNocopy}{false}
+\newboolean{OptTitleonly}\setboolean{OptTitleonly}{false}
+
+\newcommand{\PRISMDOCZikTitle}{PRISM-interne Kurzinformation}
+\newcommand{\PRISMDOCZhbTitle}{PRISM-internes Handbuch}
+\newcommand{\PRISMDOCIbTitle}{Interner Bericht}
+\newcommand{\PRISMDOCtype}{}
+\newcommand{\PRISMDOCDebugBox}[1]{}
+\newcommand{\PRISMDOCFont}[6]{\fontencoding{#1}\fontfamily{#2}\fontseries{#3}
+                               \fontshape{#4}\fontsize{#5}{#6}\selectfont}
+
+\DeclareOption*{%
+  \typeout{PRISMDOC: \CurrentOption\ passed to base class}
+  \PassOptionsToClass{\CurrentOption}{article}%
+  \PassOptionsToClass{\CurrentOption}{report}%
+  }
+\DeclareOption{a4paper}{\typeout{PRISMDOC:
+    {\CurrentOption}  will not be used}}
+\DeclareOption{a5paper}{\typeout{PRISMDOC:
+    {\CurrentOption}  will not be used}}
+\DeclareOption{sectochap}{
+  \setboolean{OptSectoChap}{true}
+  }
+\DeclareOption{chaptosec}{
+  \setboolean{OptChaptoSec}{true}
+  }
+\DeclareOption{rs}{
+% middle part of Doc Type:e.g.Report
+  \renewcommand{\PRISMDOCtype}{}
+  \setboolean{IsItaRS}{true}
+  \setboolean{OptChaptoSec}{false}
+  }
+\DeclareOption{tki}{
+  \renewcommand{\PRISMDOCtype}{TKI}
+  }
+
+\DeclareOption{zik}{
+  \renewcommand{\PRISMDOCtype}{ZIK}
+  \setboolean{IsItaZIK}{true}
+  }
+\DeclareOption{zhb}{
+  \renewcommand{\PRISMDOCtype}{ZHB}
+  \setboolean{IsItaRS}{true}
+  \setboolean{IsItaZHB}{true}
+  }
+\DeclareOption{ib}{
+  \renewcommand{\PRISMDOCtype}{IB}
+  \setboolean{IsItaRS}{true}
+  }
+\DeclareOption{toc}{
+  \setboolean{OptToc}{false}
+  }
+\DeclareOption{noarabic}{
+  \setboolean{OptNoArabic}{true}
+  }
+\DeclareOption{lof}{
+  \setboolean{OptFigureList}{false}
+  }
+\DeclareOption{lot}{
+  \setboolean{OptTableList}{false}
+  }
+\DeclareOption{loe}{
+  \setboolean{OptExampleList}{false}
+  }
+\DeclareOption{lop}{
+  \setboolean{OptProgramList}{false}
+  }
+\DeclareOption{loj}{
+  \setboolean{OptJobList}{false}
+  }
+\DeclareOption{english}{
+  \renewcommand{\PRISMDOCZikTitle}{PRISM internal Technical Reference}
+  \renewcommand{\PRISMDOCZhbTitle}{PRISM Internal User's Manual}
+  \renewcommand{\PRISMDOCIbTitle}{Technical Report}
+  }
+\DeclareOption{index}{
+  \setboolean{OptIndex}{true}
+  }
+\DeclareOption{nocopy}{
+  \setboolean{OptNocopy}{true}
+  }
+\DeclareOption{docurs}{
+  \renewcommand{\PRISMDOCtype}{Report}
+  \setboolean{IsItaRS}{true}
+  \setboolean{IsItaDOCU}{true}
+  }
+\DeclareOption{docu}{
+  \setboolean{IsItaDOCU}{true}
+  }
+\DeclareOption{titleonly}{
+  \setboolean{OptTitleonly}{true}
+  }
+\DeclareOption{overfull}{
+  \setlength{\overfullrule}{2pt}
+  }
+\DeclareOption{debug}{
+  \renewcommand{\PRISMDOCDebugBox}[1]{#1}
+  }
+\DeclareOption{oldfloat}{
+  \setboolean{OptOldFloat}{true}
+  }
+\DeclareOption{low}{
+  \setboolean{OptLow}{true}
+  }
+\DeclareOption{wide}{
+  \setboolean{OptWide}{true}
+  }
+\ProcessOptions\relax
+\ifthenelse{\boolean{IsItaRS}}
+{%
+  \LoadClass[twoside,11pt]{report}
+}% else
+{
+  {
+    \typeout{PRISMDOC: No document type found, assuming RS}
+    \LoadClass[twoside,11pt]{report}
+    }
+}
+\RequirePackage{varioref}
+\RequirePackage{times}
+\RequirePackage{tabularx}
+\RequirePackage{fancyheadings}
+\RequirePackage{float}
+\RequirePackage[hang,bf,small,nooneline]{caption}
+\RequirePackage{expdlist}
+\RequirePackage{varioref}
+\RequirePackage{multicol}
+\RequirePackage{changebar}
+\RequirePackage{alltt}
+\newcolumntype{C}{>{\centering\arraybackslash}X}%
+\newcommand{\htmladdnormallink}[2]{#1}
+%\RequirePackage[dvips]{epsfig}
+\ifthenelse{\boolean{OptIndex}}%
+{
+  \RequirePackage{makeidx}
+}{}
+\ifthenelse{\boolean{OptChaptoSec}}
+{%
+\newcommand\chapter{\@startsection {section}{1}{\z@}%
+                                   {-3.5ex \@plus -1ex \@minus -.2ex}%
+                                   {2.3ex \@plus.2ex}%
+                                   {\normalfont\Large\bfseries}}
+\renewcommand\section{\@startsection{subsection}{2}{\z@}%
+                                     {-3.25ex\@plus -1ex \@minus -.2ex}%
+                                     {1.5ex \@plus .2ex}%
+                                     {\normalfont\large\bfseries}}
+\renewcommand\subsection{\@startsection{subsubsection}{3}{\z@}%
+                                     {-3.25ex\@plus -1ex \@minus -.2ex}%
+                                     {1.5ex \@plus .2ex}%
+                                     {\normalfont\normalsize\bfseries}}
+\renewcommand\subsubsection{\@startsection{paragraph}{4}{\z@}%
+                                    {3.25ex \@plus1ex \@minus.2ex}%
+                                    {-1em}%
+                                    {\normalfont\normalsize\bfseries}}
+\renewcommand\paragraph{\@startsection{subparagraph}{5}{\parindent}%
+                                       {3.25ex \@plus1ex \@minus .2ex}%
+                                       {-1em}%
+                                      {\normalfont\normalsize\bfseries}}
+\renewcommand\subparagraph{\@startsection{subparagraph}{5}{\parindent}%
+                                       {3.25ex \@plus1ex \@minus .2ex}%
+                                       {-1em}%
+                                      {\normalfont\normalsize\bfseries}}
+}{}
+\ifthenelse{\boolean{OptSectoChap}}
+{%
+\renewcommand{\section}{\if@openright\cleardoublepage\else\clearpage\fi
+                    \thispagestyle{plain}%
+                    \global\@topnum\z@
+                    \@afterindentfalse
+                    \secdef\@chapter\@schapter}
+\renewcommand{\subsection}{\@startsection {section}{1}{\z@}%
+                                   {-3.5ex \@plus -1ex \@minus -.2ex}%
+                                   {2.3ex \@plus.2ex}%
+                                   {\normalfont\Large\bfseries}}
+\renewcommand{\subsubsection}{\@startsection{subsection}{2}{\z@}%
+                                     {-3.25ex\@plus -1ex \@minus -.2ex}%
+                                     {1.5ex \@plus .2ex}%
+                                     {\normalfont\large\bfseries}}
+\renewcommand{\paragraph}{\@startsection{subsubsection}{3}{\z@}%
+                                     {-3.25ex\@plus -1ex \@minus -.2ex}%
+                                     {1.5ex \@plus .2ex}%
+                                     {\normalfont\normalsize\bfseries}}
+\renewcommand{\subparagraph}{\@startsection{paragraph}{4}{\z@}%
+                                    {3.25ex \@plus1ex \@minus.2ex}%
+                                    {-1em}%
+                                    {\normalfont\normalsize\bfseries}}
+}{}
+\voffset=-1in
+\hoffset=-1in
+\ifthenelse{\boolean{OptWide}}%
+{ %
+  \textwidth=16.2cm
+  \oddsidemargin=2.4cm
+  \evensidemargin=2.4cm
+}{ % else
+  \textwidth=15.2cm
+  \oddsidemargin=2.9cm
+  \evensidemargin=2.9cm
+}
+\topmargin=1.4cm
+\headheight=0.8cm
+\headsep=0.3cm
+\textheight=24.5cm
+\footskip=1.3cm
+\marginparwidth=1cm
+\setcounter{topnumber}{3}
+\setcounter{bottomnumber}{3}
+\setcounter{totalnumber}{6}
+\renewcommand{\topfraction}{0.8}
+\renewcommand{\bottomfraction}{0.8}
+\renewcommand{\textfraction}{0.1}
+\setlength\parskip{0.5ex \@plus 0.2ex}
+\setlength\parindent{0pt}
+\def\@listI{\leftmargin\leftmargini
+            \parsep \parskip
+            \topsep \z@
+            \itemsep\z@}
+\let\@listi\@listI
+\@listi
+\def\@listii {\leftmargin\leftmarginii
+              \labelwidth\leftmarginii
+              \advance\labelwidth-\labelsep
+              \topsep    \z@
+              \parsep    \parskip
+              \itemsep   \z@}
+\def\@listiii{\leftmargin\leftmarginiii
+              \labelwidth\leftmarginiii
+              \advance\labelwidth-\labelsep
+              \topsep    \z@
+              \parsep    \parskip
+              \partopsep \z@
+              \itemsep   \topsep}
+\def\@listiv {\leftmargin\leftmarginiv
+              \labelwidth\leftmarginiv
+              \advance\labelwidth-\labelsep}
+\def\@listv  {\leftmargin\leftmarginv
+              \labelwidth\leftmarginv
+              \advance\labelwidth-\labelsep}
+\def\@listvi {\leftmargin\leftmarginvi
+              \labelwidth\leftmarginvi
+              \advance\labelwidth-\labelsep}
+\hfuzz=2mm
+\newcommand{\PRISMDOCnum}{}
+\newcommand{\PRISMDOCautor}{}
+\newcommand{\PRISMDOCfname}{}
+\newcommand{\PRISMDOCsname}{}
+\newcommand{\PRISMDOCfphone}{}
+\newcommand{\PRISMDOCsphone}{}
+\newcommand{\PRISMDOCfwp}{}
+\newcommand{\PRISMDOCfaff}{}
+\newcommand{\PRISMDOCsaff}{}
+\newcommand{\PRISMDOCfem}{}
+\newcommand{\PRISMDOCswp}{}
+\newcommand{\PRISMDOCdate}{}
+\newcommand{\PRISMDOCversion}{}
+\newcommand{\PRISMDOCtitel}{}
+\newcommand{\PRISMDOCremark}{}
+\newcommand{\PRISMDOCfigsize}{}
+\newcommand{\prismdocType}[1]{\renewcommand{\PRISMDOCtype}{#1}}
+\newcommand{\prismdocNum}[1]{\renewcommand{\PRISMDOCnum}{#1}}
+\newcommand{\prismdocAutor}[1]{\renewcommand{\PRISMDOCautor}{#1}}
+\newcommand{\prismdocFName}[1]{\renewcommand{\PRISMDOCfname}{#1}}
+\newcommand{\prismdocSName}[1]{\renewcommand{\PRISMDOCsname}{#1}}
+\newcommand{\prismdocFPhone}[1]{\renewcommand{\PRISMDOCfphone}{#1}}
+\newcommand{\prismdocSPhone}[1]{\renewcommand{\PRISMDOCsphone}{#1}}
+\newcommand{\prismdocFWp}[1]{\renewcommand{\PRISMDOCfwp}{#1}}
+\newcommand{\prismdocSWp}[1]{\renewcommand{\PRISMDOCswp}{#1}}
+\newcommand{\prismdocFAff}[1]{\renewcommand{\PRISMDOCfaff}{#1}}
+\newcommand{\prismdocSAff}[1]{\renewcommand{\PRISMDOCsaff}{#1}}
+\newcommand{\prismdocFEm}[1]{\renewcommand{\PRISMDOCfem}{#1}}
+\newcommand{\prismdocVersion}[1]{\renewcommand{\PRISMDOCversion}{#1}}
+\newcommand{\prismdocDate}[1]{\renewcommand{\PRISMDOCdate}{#1}}
+\newcommand{\prismdocTitel}[1]{\renewcommand{\PRISMDOCtitel}{#1}}
+\newcommand{\prismdocRemark}[1]{\renewcommand{\PRISMDOCremark}{#1}}
+\newcommand{\prismdocFigSize}[1]{\renewcommand{\PRISMDOCfigsize}{#1}}
+
+\newcommand{\prismdocHeader}{}
+\newcommand{\prismdocTOC}{}
+
+\ifthenelse{\boolean{IsItaRS}}
+{%
+  \pagestyle{fancy}
+  \lhead[{\bfseries\thepage}]{\bfseries\rightmark}
+  \rhead[{\bfseries\leftmark}]{\bfseries\thepage}
+  \lfoot[{}]{}
+  \cfoot{}{}
+  \setlength{\headrulewidth}{0.4pt}
+  \ifthenelse{\boolean{OptIndex}}
+  {%
+    \makeindex
+    }{}
+  \renewcommand{\prismdocHeader}{%
+    \ifthenelse{\boolean{IsItaDOCU}}{
+    %  Title page
+      \thispagestyle{empty}
+      \setlength{\unitlength}{1cm}
+      \ifthenelse{\boolean{OptWide}}%
+      {\hspace*{5mm}}{}%
+      \newpage
+      \thispagestyle{empty}
+      \ \ \\
+      \newpage
+      }{}
+    \thispagestyle{empty}
+    \setlength{\unitlength}{1cm}
+    \ifthenelse{\boolean{OptWide}}%
+    {\hspace*{5mm}}{}%
+    \begin{picture}(15.2,24.5)
+      \ifthenelse{\not\(\boolean{IsItaIB}\or \boolean{IsItaDOCU}\)}%
+      {
+        \PRISMDOCDebugBox{\put(0,0){\dashbox{0.1}(15.2,24.5){}}}
+        \PRISMDOCDebugBox{\put(2.5,8.1){\dashbox{0.1}(10.3,10.3){}}}
+        \PRISMDOCDebugBox{\put(1.6,22.1){\dashbox{0.1}(12,2){}}}
+        % \put(1.6,22.1){\makebox(12,2){\parbox{12cm}{
+        %       \begin{center}
+        %         \vspace*{-\topsep}
+        %       {\PRISMDOCFont{T1}{ptm}{b}{n}{14pt}{18pt}
+        %         PRISM \\} 
+        %         % Project for Integrated Earth System Modelling \\ }
+        %       {\PRISMDOCFont{T1}{ptm}{b}{n}{12pt}{14pt}
+        %         An Infrastructure Project for Climate Research in Europe \par}
+        %         %funded by the European Commission \\
+        %         %under Contract  EVR1-CT2001-40012 \par
+        %         %}
+        %       \vspace*{-\topsep}
+        %     \end{center}}}}
+                                % Logo
+      \PRISMDOCDebugBox{\put(4.35,18.8){\dashbox{0.1}(6.5,0.5)[t]{}}}
+      \put(4.35,18.8){\makebox(6.5,0.5)[t]{
+          \parbox{6.5cm}{
+             \begin{center}
+               \vspace*{-\topsep}
+                \centering
+                 \includegraphics[width=4cm,angle=-90]{figures/logo_oasis3_guide}
+               \vspace*{-\topsep}
+             \end{center}
+                 }}}
+                                % Title
+        \PRISMDOCDebugBox{\put(2.8,9.3){\dashbox{0.1}(9.6,2.5)[t]{}}}
+        \put(2.8,9.3){\makebox(9.6,2.5)[t]{
+            \parbox{9cm}{
+              \begin{center}
+                \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{b}{n}{14pt}{18pt}
+                \PRISMDOCtitel\par}
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % Authors
+      \PRISMDOCDebugBox{\put(3.1,7.3){\dashbox{0.1}(9,1.5)[t]{}}}
+      \put(3.1,7.3){\makebox(9,1.5)[t]{
+          \parbox{15cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{sl}{11pt}{12pt}
+                \PRISMDOCautor\par}
+              \vspace*{-\topsep}
+            \end{center}}}}
+%                                 % Volume
+%       \PRISMDOCDebugBox{\put(5.35,3.3){\dashbox{0.1}(4.5,0.4)[t]{}}}
+%       \put(5.35,3.3){\makebox(4.5,0.4)[t]{
+%           \parbox{4.5cm}{
+%             \begin{center}
+%               \vspace*{-\topsep}
+%               {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+%                 PRISM-\PRISMDOCtype-\PRISMDOCnum}
+%               \vspace*{-\topsep}
+%             \end{center}}}}
+                                % Edition
+      \PRISMDOCDebugBox{\put(4.35,1.1){\dashbox{0.1}(6.5,0.4)[t]{}}}
+      \put(4.35,1.1){\makebox(6.5,0.4)[t]{
+          \parbox{6.5cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+                \PRISMDOCversion}
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % Last changed: ??
+      \PRISMDOCDebugBox{\put(4.35,2.3){\dashbox{0.1}(6.5,0.5)[t]{}}}
+%S.L. left coordinate of box=\put(N.N,...)
+%S.L. height of lower frame=\put(...,N.N)
+%S.L. width of text box= \parbox{N.Ncm} 
+\put(4.35,0.3){\makebox(6.5,0.5)[t]{ 
+          \parbox{6.5cm}{   
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+                \PRISMDOCdate }
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % Notes
+      \PRISMDOCDebugBox{\put(0,1.4){\dashbox{0.1}(13,1.5)[t]{}}}
+      \put(0,1.4){\makebox(13,1.5)[t]{
+          \parbox{13cm}{
+            {\PRISMDOCFont{T1}{ptm}{m}{n}{10pt}{12pt}\PRISMDOCremark}}}}
+      }{ % else
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+                                % IB: RS oder ZHB
+      \PRISMDOCDebugBox{\put(3.1,14.3){\dashbox{0.1}(9,0.9)[t]{}}}
+      \put(3.1,14.3){\makebox(9,0.9)[t]{
+          \parbox{9cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+                \ifthenelse{\boolean{IsItaZHB}}%
+                  {\PRISMDOCZhbTitle}%
+                  {%
+                    \ifthenelse{\boolean{IsItaIB}}%
+                    {\PRISMDOCIbTitle}%
+                    }%
+                  }%
+                \vspace*{-\topsep}
+              \end{center}}}}
+                                % IB: Title
+        \PRISMDOCDebugBox{\put(2.6,10.8){\dashbox{0.1}(10.0,2.5)[t]{}}}
+        \put(2.6,10.8){\makebox(10.0,2.5)[t]{
+            \parbox{9cm}{
+              \begin{center}
+                \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{b}{n}{14pt}{18pt}
+                \PRISMDOCtitel\par}
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % IB: Authors
+      \PRISMDOCDebugBox{\put(3.1,8.0){\dashbox{0.1}(9,1.5)[t]{}}}
+      \put(3.1,8.0){\makebox(9,1.5)[t]{
+          \parbox{9cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{sl}{11pt}{12pt}
+                \PRISMDOCautor\par}
+              \vspace*{-\topsep}
+            \end{center}}}}
+%                                 % IB: Volume
+%       \PRISMDOCDebugBox{\put(5.35,7.0){\dashbox{0.1}(4.5,0.4)[t]{}}}
+%       \put(5.35,7.0){\makebox(4.5,0.4)[t]{
+%           \parbox{4.5cm}{
+%             \begin{center}
+%               \vspace*{-\topsep}
+%               {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+%                 PRISM-\PRISMDOCtype-\PRISMDOCnum}
+%               \vspace*{-\topsep}
+%             \end{center}}}}
+                                % IB: Edition
+      \PRISMDOCDebugBox{\put(4.35,5.1){\dashbox{0.1}(6.5,0.4)[t]{}}}
+      \put(4.35,5.1){\makebox(6.5,0.4)[t]{
+          \parbox{6.5cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+                \PRISMDOCversion}
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % IB: Last changed
+      \PRISMDOCDebugBox{\put(4.35,6.3){\dashbox{0.1}(6.5,0.5)[t]{}}}
+      \put(4.35,6.3){\makebox(6.5,0.5)[t]{
+          \parbox{6.5cm}{
+            \begin{center}
+              \vspace*{-\topsep}
+              {\PRISMDOCFont{T1}{ptm}{m}{n}{12pt}{14pt}
+                (last change: \PRISMDOCdate)}
+              \vspace*{-\topsep}
+            \end{center}}}}
+                                % IB: Remark
+      \PRISMDOCDebugBox{\put(0,1.4){\dashbox{0.1}(13,1.5)[t]{}}}
+      \put(0,1.4){\makebox(13,1.5)[t]{
+          \parbox{15cm}{
+            {\PRISMDOCFont{T1}{ptm}{m}{n}{10pt}{12pt}\PRISMDOCremark}}}}
+      }
+      \end{picture}
+\newpage
+    \thispagestyle{empty}
+    \ifthenelse{\boolean{OptWide}}%
+    {\hspace*{5mm}}{}
+    \begin{picture}(15.2,24.5)
+                                % Body for Text
+    \PRISMDOCDebugBox{\put(0,0){\dashbox{0.1}(15.2,24.9){}}}
+
+    \ifthenelse{\boolean{IsItaIB}}{}%else
+    {
+    \PRISMDOCDebugBox{\put(0,21.4){\dashbox{0.1}(15,3.4)[t]{}}}
+    \ifthenelse{\boolean{OptNocopy}}{}%else
+    {
+      \put(0,21.4){\makebox(15,3.4)[t]{
+          \parbox{15cm}{
+            {\PRISMDOCFont{T1}{ptm}{b}{n}{12pt}{14pt}Copyright Notice\\[0.5ex]}
+            \PRISMDOCFont{T1}{ptm}{m}{n}{11pt}{13pt}
+            \copyright\ Copyright 2013 by CERFACS \\
+            All rights reserved.\\
+            No parts of this document should be either reproduced or 
+            commercially used without prior agreement 
+            by CERFACS representatives.  \\
+            }}}
+      }
+
+      \PRISMDOCDebugBox{\put(0,9){\dashbox{0.1}(15,5.2)[t]{}}}
+      \put(0,9){\makebox(15,5.2)[t]{
+          \parbox{15cm}{
+            {\PRISMDOCFont{T1}{ptm}{b}{n}{12pt}{14pt}
+              How to get documentation ?\\[0.5ex]}
+            \PRISMDOCFont{T1}{ptm}{m}{n}{11pt}{13pt}
+            The documentation can be downloaded from the OASIS web site under the URL : \\
+            http://oasis.enes.org \\
+            }}}
+
+      \PRISMDOCDebugBox{\put(0,16.2){\dashbox{0.1}(15,5.2)[t]{}}}
+      \put(0,16.2){\makebox(15,5.2)[t]{
+          \parbox{15cm}{
+            {\PRISMDOCFont{T1}{ptm}{b}{n}{12pt}{14pt}
+              How to get assistance?\\[0.5ex]}
+            \PRISMDOCFont{T1}{ptm}{m}{n}{11pt}{13pt}
+            Assistance can be obtained as listed below. 
+            }}}
+
+      \PRISMDOCDebugBox{\put(0,14.4){\dashbox{0.1}(15,2.2)[t]{}}}
+      \put(0,16.6){\makebox(15,2.2)[t]{
+          \parbox{15cm}{
+            {\PRISMDOCFont{T1}{ptm}{b}{n}{12pt}{14pt}
+              Phone Numbers and Electronic Mail Adresses
+              \\[0.5ex]}
+%            \PRISMDOCFont{T1}{ptm}{m}{n}{11pt}{13pt}
+%            Electronic mail adresses of the individual work packages are composed as follows :\\
+%            \textbf{prism\_ \textit{work package} @prism.enes.org}
+            }}}
+
+      \PRISMDOCDebugBox{\put(0,4.1){\dashbox{0.1}(15,11.0)[t]{}}}
+      \put(0,7.1){\makebox(15,11.0)[t]{
+          \parbox{15cm}{
+            \newcommand{\PRISMDOCtblbf}{\PRISMDOCFont{T1}{ptm}{b}{n}{9.8pt}{11pt}}
+            \newcommand{\PRISMDOCtblit}{\PRISMDOCFont{T1}{ptm}{m}{it}{9.8pt}{11pt}}
+            \newcommand{\PRISMDOCtblbi}{\PRISMDOCFont{T1}{ptm}{b}{it}{9.8pt}{11pt}}
+            \PRISMDOCFont{T1}{ptm}{m}{n}{9.8pt}{11pt}
+            \renewcommand{\arraystretch}{1.11}
+            \setlength{\tabcolsep}{4pt}
+            \begin{tabular}[t]{|p{4.6cm}|p{3.1cm}|p{2.2cm}|p{3.1cm}|}
+              \hline%\rowcolor[gray]{0.2}
+              \PRISMDOCtblbf Name&
+              \PRISMDOCtblbf Phone &
+              \PRISMDOCtblbf Affiliation & 
+              \PRISMDOCtblbf e-mail \\ 
+              \hline\hline
+              \PRISMDOCfname\par & \PRISMDOCfphone\par & \PRISMDOCfaff\par & \PRISMDOCfem\par \\
+              \PRISMDOCsname\par & \PRISMDOCsphone\par & \PRISMDOCsaff\par & \par \\
+              \hline
+            \end{tabular}
+            }}}
+
+     \PRISMDOCDebugBox{\put(0,-0.5){\dashbox{0.1}(15,4.0)[b]{}}}
+      \put(0,-0.5){\makebox(15,4.0)[b]{
+          \parbox{15cm}{
+            \renewcommand{\arraystretch}{1.10}
+            \PRISMDOCFont{T1}{ptm}{m}{n}{9.8pt}{11pt}
+            }}}
+      } % IsItaIB
+    \end{picture}
+    \newpage
+    \pagenumbering{roman}
+    \setcounter{page}{1}
+    \ifthenelse{\boolean{OptTitleonly}}{}%
+    {
+      {
+        \parskip=0pt
+        \tableofcontents
+        \ifthenelse{\boolean{OptFigureList}}{
+          \cleardoublepage
+          \listoffigures
+          }{}
+        \ifthenelse{\boolean{OptTableList}}{
+          \cleardoublepage
+          \listoftables
+          }{}
+        \ifthenelse{\boolean{OptExampleList}}{
+          \cleardoublepage
+          \listof{Example_int}{List of Examples}
+          }{}
+        \ifthenelse{\boolean{OptProgramList}}{
+          \cleardoublepage
+          \listof{Program_int}{List of Programs}
+          }{}
+        \ifthenelse{\boolean{OptJobList}}{
+          \cleardoublepage
+          \listof{Job_int}{List of Jobs}
+          }{}
+        }
+      \cleardoublepage
+      \ifthenelse{\not\boolean{OptNoArabic}}{
+        \pagenumbering{arabic}
+      }{}
+      \cleardoublepage
+      }
+    }
+}{}
+
+
+\newcommand{\Indextt}[1]{\index{#1@\texttt{#1}}}
+\newlength{\PRISMDOCFrameskip}
+\setlength{\PRISMDOCFrameskip}{3pt}
+\newsavebox{\ffbox}
+\newlength{\ffboxl}
+\newenvironment{Frame}[1][\linewidth]{ %
+\begin{lrbox}{\ffbox}
+  \setlength{\ffboxl}{#1}
+  \addtolength{\ffboxl}{-4\fboxrule}
+  \addtolength{\ffboxl}{-4\fboxsep}
+  \begin{minipage}[t]{\ffboxl}
+}                                    %
+{                                    %
+  \end{minipage}
+\end{lrbox}
+\ifthenelse{\boolean{hmode}}{
+  \hskip\parfillskip\\[\PRISMDOCFrameskip]
+}{\vspace{\PRISMDOCFrameskip}}
+\noindent\fbox{\usebox{\ffbox}\\}%
+\vspace{\PRISMDOCFrameskip}%
+}%
+\newcommand{\Mail}[1]{\textbf{#1}}
+\newcommand{\Internet}[1]{\textbf{\texttt{#1}}}
+\newcommand{\Url}[1]{\textbf{\texttt{#1}}}
+\newcommand{\Ftp}[1]{\textbf{\texttt{#1}}}
+\newcommand{\Unixcmd}[1]{\textbf{\texttt{#1}}}
+\newcommand{\Unixopt}[1]{\textbf{\texttt{#1}}}
+\newcommand{\Varunixopt}[1]{\textbf{\texttt{\textit{#1}}}}
+\newcommand{\Shellvar}[1]{\textbf{\texttt{\$#1}}}
+\newcommand{\Path}[1]{\textbf{\texttt{#1}}}
+\newcommand{\File}[1]{\texttt{#1}}
+\newcommand{\Varfile}[1]{\texttt{\textit{#1}}}
+\newcommand{\Prompt}[1]{\texttt{#1}}
+\newcommand{\Unixmessage}[1]{\texttt{#1}}
+\newcommand{\Queue}[1]{\texttt{\textbf{#1}}}
+\newcommand{\Keyword}[1]{\texttt{#1}}
+\newcommand{\Keybrd}[1]{\fbox{\texttt{#1}}}
+%\newcommand{\Tki}[1]{\htmladdnormallink{TKI-#1}%
+%  {http://prism.enes.org}}
+\newenvironment{Indent}{ %
+\begin{list}{}{\topsep=0pt}\item[]
+}%
+{%
+\end{list}
+}
+\newcommand{\Myindent}{\hspace*{\leftmargin}}
+\newcommand{\Crayfilesrv}{\/Cray file server\/}
+\newcommand{\Crayfs}{\/Cray file server\/}
+\newcommand{\Craycs}{\/CRAY J90\/}
+\newcommand{\Craympp}{\/CRAY T3E\/}
+\newcommand{\Craypvp}{\/CRAY T90\/}
+\newcommand{\CrayfilesrvT}{Cray file server}
+\newcommand{\CrayfsT}{Cray file server}
+\newcommand{\CraycsT}{CRAY J90}
+\newcommand{\CraymppT}{CRAY T3E}
+\newcommand{\CraypvpT}{CRAY T90}
+\newcommand{\Jump}{\/Jump\/}
+\newcommand{\Homechar}{$\sim$}
+\newcommand{\Backslash}{$\backslash$}
+\newcommand{\Kea}{[}
+\newcommand{\Kez}{]}
+\newcommand\fs@Boxed{\def\@fs@cfont{\bfseries}\let\@fs@capt\floatc@plain
+  \def\@fs@pre{
+    \setbox\@currbox\vbox{%
+      \hbadness10000%
+      \vbox{%
+        \hrule%
+        \hbox to\hsize{%
+          \vrule\kern2pt%
+          \vbox{%
+            \kern5pt\box\@currbox\kern5pt%
+            }%
+          \kern-2.7pt\vrule}\hrule}%
+      }%
+    }%
+  \def\@fs@mid{\kern3pt}%
+  \def\@fs@post{}\let\@fs@iftopcapt\iffalse}
+\floatstyle{Boxed}
+\setlength{\floatsep}{6pt plus 2pt minus2pt}
+\setlength{\textfloatsep}{10pt plus 2pt minus2pt}
+\setlength{\intextsep}{6pt plus 2pt minus2pt}
+\setlength{\abovecaptionskip}{3pt}
+
+\ifthenelse{\boolean{IsItaRS}}{
+  \newfloat{Program_int}{htbp}{lop}[chapter]
+  \newfloat{Job_int}{htbp}{loj}[chapter]
+  \newfloat{Example_int}{htbp}{loe}[chapter]
+}{
+  \newfloat{Program_int}{htbp}{lop}
+  \newfloat{Job_int}{htbp}{loj}
+  \newfloat{Example_int}{htbp}{loe}
+}
+\floatname{Example_int}{Example}
+\floatname{Program_int}{Program}
+\floatname{Job_int}{Job}
+\ifthenelse{\boolean{OptOldFloat}}
+{%
+  \newenvironment{Example}%
+  {\begin{Example_int}[H]\small\begin{alltt}}%
+  {\end{alltt}\vspace*{-2ex}\end{Example_int}}%
+  \newenvironment{Longexample}%
+  {\begin{Example_int}\small}%
+  {\end{Example_int}}%
+  %
+  \newenvironment{Job}%
+  {\begin{Job_int}[H]\small\begin{alltt}}%
+  {\end{alltt}\vspace*{-2ex}\end{Job_int}}
+  \newenvironment{Longjob}%
+  {\begin{Job_int}\small}%
+  {\end{Job_int}}%
+  \newenvironment{Program}%
+  {\begin{Program_int}[H]\small\begin{alltt}}%
+  {\end{alltt}\vspace*{-2ex}\end{Program_int}}%
+  \newenvironment{Longprogram}%
+  {\begin{Program_int}\small}%
+  {\end{Program_int}}%
+}{ %else
+  \newenvironment{Shortexample}%
+  {\begin{Frame}\small\begin{alltt}}%
+  {\end{alltt}\end{Frame}}%
+  \newenvironment{Example}[1][htbp]%
+  {\begin{Example_int}[#1]\small}%
+  {\end{Example_int}}%
+  %
+  \newenvironment{Shortjob}%
+  {\begin{Frame}\small\begin{alltt}}%
+  {\end{alltt}\end{Frame}}
+  \newenvironment{Job}[1][htbp]%
+  {\begin{Job_int}[#1]\small}%
+  {\end{Job_int}}%
+  \newenvironment{Shortprogram}%
+  {\begin{Frame}\small\begin{alltt}}%
+  {\end{alltt}\end{Frame}}%
+  \newenvironment{Program}[1][htbp]%
+  {\begin{Program_int}[#1]\small}%
+  {\end{Program_int}}%
+}
+\ifthenelse{\boolean{IsItaRS}}
+{%
+  \floatstyle{Boxed}
+% Comment line below if you dont want a frome around the figures
+  \restylefloat{figure}
+}{}
+\newenvironment{Itemize*}%
+{ \partopsep=0pt%
+  \begin{itemize}%
+    \vspace*{-\topsep}%
+    \parskip=0pt\itemsep=0pt\partopsep=0pt%%
+}%
+{%
+  \vspace*{-\topsep}%
+\end{itemize}%
+}
+\newenvironment{Enumerate*}%
+{ \partopsep=0pt%
+  \begin{enumerate}%
+    \vspace*{-\topsep}%
+    \parskip=0pt\itemsep=0pt\partopsep=0pt%%
+}%
+{%
+  \vspace*{-\topsep}%
+\end{enumerate}%
+}
+\newcommand{\longpage}%
+{\enlargethispage{\baselineskip}\PRISMDOCDebugBox{\marginpar{\fbox{+}}}}
+\newcommand{\shortpage}%
+{\enlargethispage{-\baselineskip}\PRISMDOCDebugBox{\marginpar{\fbox{-}}}}
+
+\ifthenelse{\boolean{OptLow}}%
+{%
+\newenvironment{itemize*}%
+{\begin{Itemize*}}%
+{\end{Itemize*}}
+\newenvironment{enumerate*}%
+{\begin{Enumerate*}}%
+{\end{Enumerate*}}
+}{}
+\AtEndDocument{
+
+  \ifthenelse{\boolean{OptIndex}}%
+  {%
+    \appendix
+    \addcontentsline{toc}{chapter}{Index}
+    {\small
+      \printindex
+      }
+    }{}
+    % Katalog
+  \ifthenelse{\boolean{IsItaRS} \and \not \boolean{IsItaIB} \and \not \boolean{IsItaZHB}}%
+  {%
+    \ifthenelse{\boolean{OptTitleonly}}
+    {}{%
+      \cleardoublepage%
+      \pagestyle{empty}%
+     % \input{./styles/bhb-katalog.tex}%
+      }%
+    }{}%
+  }%
+
+\endinput
+%%
+%% End of file `prismdoc.cls'.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/Makefile	(revision 4775)
@@ -0,0 +1,89 @@
+#
+include header_Makefile
+LIBPSMILE = $(ARCHDIR)/lib/libpsmile.${CHAN}.a $(ARCHDIR)/lib/libmct.a $(ARCHDIR)/lib/libmpeu.a $(ARCHDIR)/lib/libscrip.a
+#
+##### User configurable options #####
+#
+# CPP keys for model 1 (_M1) and for model 2 (_M2)
+# type of decomposition :
+# DECOMP_APPLE for 1D decomposition
+# DECOMP_BOX for 2D decomposition
+CPPKEYDECOMP_M1=DECOMP_APPLE
+CPPKEYDECOMP_M2=DECOMP_APPLE
+#
+# Precision for REAL: USE_DOUBLE_PRECISION or NO_USE_DOUBLE_PRECISION
+include header_precision
+CPPLOCAL_M1 = -D${CPPKEYDP} -D${CPPKEYDECOMP_M1}
+CPPLOCAL_M2 = -D${CPPKEYDP} -D${CPPKEYDECOMP_M2}
+#
+### End User configurable options ###
+#
+OBJ_M1 =  routine_hdlerr.o read_all_data.o \
+          decomp_def.o \
+          function_ana.o write_all_fields.o
+OBJ_M2 =  routine_hdlerr.o read_all_data.o \
+          decomp_def_m2.o \
+          function_ana.o  write_all_fields.o
+#-------------------------------------------------------------------------------
+# General rules
+#-------------------------------------------------------------------------------
+#
+default: all
+#
+all: oasis3_psmile model1 model2
+#
+# Compile and link libaries
+oasis3_psmile:
+	(cd $(O3DIR)/util/make_dir ; $(MAKE) oasis3_psmile -f TopMakefileOasis3)
+#
+#
+#-------------------------------------------------------------------------------
+# Rules for executables
+#-------------------------------------------------------------------------------
+#
+model1: $(OBJ_M1) model1.o $(LIBPSMILE) Makefile
+	$(LD) $(LDFLAGS) -o $@ $(OBJ_M1) model1.o $(LIBPSMILE) $(FLIBS)
+model2: $(OBJ_M2) model2.o $(LIBPSMILE) Makefile
+	$(LD) $(LDFLAGS) -o $@ $(OBJ_M2) model2.o $(LIBPSMILE) $(FLIBS)
+#
+#-------------------------------------------------------------------------------
+# Rules for compilation
+#-------------------------------------------------------------------------------
+#
+routine_hdlerr.o :		routine_hdlerr.F90
+				$(F90) $(F90FLAGS) -c routine_hdlerr.F90
+read_all_data.o :		read_all_data.F90
+				$(F90) $(F90FLAGS) -D${CPPKEYDP} -c read_all_data.F90
+write_all_fields.o :		write_all_fields.F90
+				$(F90) $(F90FLAGS) -D${CPPKEYDP} -c write_all_fields.F90
+function_ana.o :		function_ana.F90
+				$(F90) $(F90FLAGS) -D${CPPKEYDP} -c function_ana.F90
+decomp_def.o : 			decomp_def.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M1) -c decomp_def.F90
+decomp_def_m2.o : 		decomp_def.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M2) -o decomp_def_m2.o -c decomp_def.F90
+
+model1.o :	model1.F90 Makefile
+		$(F90) $(F90FLAGS) $(CPPLOCAL_M1) -c model1.F90
+model2.o :	model2.F90 Makefile
+		$(F90) $(F90FLAGS) $(CPPLOCAL_M2) -c model2.F90
+#
+#-------------------------------------------------------------------------------
+# Utilities
+#-------------------------------------------------------------------------------
+#
+help:
+	more Make.help
+#
+# Clean directory
+#
+clean:
+	-rm -f *.o *.mod *.MOD model1 model2
+	-rm -f i.*.F90 *.L
+	-rm -f core core.* 
+#
+# Make sure to recompile everything
+#
+realclean: clean remove
+remove:
+	(cd $(O3DIR)/util/make_dir ; $(MAKE) realclean -f TopMakefileOasis3)
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/Makefile	(revision 4775)
@@ -0,0 +1,56 @@
+#
+##### User configurable options #####
+#
+F90=pgf90
+F90FLAGS=-C -g -Mbounds -byteswapio
+LD=pgf90
+NETCDF_INC=-I/usr/local/include
+NETCDF_LIB=-L/usr/local/lib -lnetcdff -lnetcdf -L/usr/local/HDF5-1.8.6/lib -lhdf5_hl -lhdf5 -lz -lm -lhdf5_hl -lhdf5 -lz -lcurl 
+### End User configurable options ###
+#
+OBJ =  routine_hdlerr.o read_dimgrid.o read_grid_mask.o write_grids_masks.o
+#-------------------------------------------------------------------------------
+# General rules
+#-------------------------------------------------------------------------------
+#
+default: all
+#
+all: create_aux_files
+#
+#-------------------------------------------------------------------------------
+# Rules for executables
+#-------------------------------------------------------------------------------
+#
+create_aux_files: 	$(OBJ) create_aux_files.o Makefile
+			$(LD) -o $@ $(OBJ) $(NETCDF_LIB) create_aux_files.o 
+#
+#-------------------------------------------------------------------------------
+# Rules for compilation
+#-------------------------------------------------------------------------------
+#
+routine_hdlerr.o :		routine_hdlerr.F90
+				$(F90) $(F90FLAGS) -c routine_hdlerr.F90 $(NETCDF_INC)
+read_dimgrid.o :		read_dimgrid.F90
+				$(F90) $(F90FLAGS) -c read_dimgrid.F90 $(NETCDF_INC)
+read_grid_mask.o :		read_grid_mask.F90
+				$(F90) $(F90FLAGS) -c read_grid_mask.F90 $(NETCDF_INC)
+write_grids_masks.o :		write_grids_masks.F90
+				$(F90) $(F90FLAGS) -c write_grids_masks.F90 $(NETCDF_INC)
+
+create_aux_files.o :	create_aux_files.F90 Makefile
+			$(F90) $(F90FLAGS) -c create_aux_files.F90 $(NETCDF_INC)
+#
+#-------------------------------------------------------------------------------
+# Utilities
+#-------------------------------------------------------------------------------
+#
+help:
+	more Make.help
+#
+# Clean directory
+#
+clean:
+	-rm -f *.o *.mod *.MOD create_aux_files
+	-rm -f i.*.F90 *.L
+	-rm -f core core.* 
+#
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/create_aux_files.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/create_aux_files.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/create_aux_files.F90	(revision 4775)
@@ -0,0 +1,136 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+!
+PROGRAM create_aux_files
+  !
+  ! Use for netCDF library
+  USE netcdf
+  !
+  IMPLICIT NONE
+  !
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+  !
+  CHARACTER(len=30)   :: data_filename_g1
+  CHARACTER(len=30)   :: data_filename_g2
+  ! 
+  CHARACTER(len=128) :: comp_out                 ! name of the output log file 
+  CHARACTER(len=2)   :: chout
+  CHARACTER(len=4)   :: src_grd_ini, src_grd_end ! Source grid names
+  CHARACTER(len=4)   :: tgt_grd_ini, tgt_grd_end ! Source grid names
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon1, nlat1     ! dimensions in the 2 directions of space
+  INTEGER :: nlon2, nlat2     ! dimensions in the 2 directions of space
+  INTEGER :: ntot             ! total dimension
+  INTEGER :: nc               ! number of corners
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER    :: ggrid1_lon,ggrid1_lat ! lon, lat of the points
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER  :: ggrid1_clo,ggrid1_cla ! lon, lat of the corners
+  INTEGER, DIMENSION(:,:), POINTER             :: g1_mask ! 
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER    :: ggrid2_lon,ggrid2_lat ! lon, lat of the points
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER  :: ggrid2_clo,ggrid2_cla ! lon, lat of the corners
+  INTEGER, DIMENSION(:,:), POINTER             :: g2_mask ! 
+  !
+  INTEGER :: ierror
+  INTEGER :: i, j
+  !
+  INTEGER, PARAMETER    :: w_unit = 15
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GET THE NAME OF THE INITIAL GRIDS AND FINAL GRIDS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  CALL getarg(1,data_filename_g1)
+  PRINT *, 'Source grid file = ', data_filename_g1
+  CALL getarg(2,data_filename_g2)
+  PRINT *, 'Target grid file = ', data_filename_g2
+  CALL getarg(3,src_grd_ini)
+  PRINT *, 'Initial Source grid acronym = ', src_grd_ini
+  CALL getarg(4,tgt_grd_ini)
+  PRINT *, ' Initial Target grid acronym = ', tgt_grd_ini
+  CALL getarg(5,src_grd_end)
+  PRINT *, 'Final Source grid acronym = ', src_grd_end
+  CALL getarg(6,tgt_grd_end)
+  PRINT *, ' Final Target grid acronym = ', tgt_grd_end
+
+  comp_out='create_aux_files.out'
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  READ GRIDS OF THE TWO MODELS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading dimensions of the first global grid
+  CALL read_dimgrid(nlon1,nlat1,data_filename_g1,w_unit,src_grd_ini)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(ggrid1_lon(nlon1,nlat1), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(ggrid1_lat(nlon1,nlat1), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(ggrid1_clo(nlon1,nlat1,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(ggrid1_cla(nlon1,nlat1,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(g1_mask(nlon1,nlat1), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the global grid
+  CALL read_grid_mask(nlon1,nlat1,nc, data_filename_g1, w_unit, src_grd_ini,  &
+                      ggrid1_lon,ggrid1_lat, &
+                      ggrid1_clo,ggrid1_cla, &
+                      g1_mask)
+
+  ! Mask inversion to follow (historical) OASIS3 convention (0=not masked;1=masked)
+  WHERE(g1_mask == 1) 
+      g1_mask=0
+  ELSEWHERE
+      g1_mask=1
+  END WHERE
+  !
+  ! Reading dimensions of the second global grid
+  CALL read_dimgrid(nlon2,nlat2,data_filename_g2,w_unit,tgt_grd_ini)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(ggrid2_lon(nlon2,nlat2), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(ggrid2_lat(nlon2,nlat2), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(ggrid2_clo(nlon2,nlat2,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(ggrid2_cla(nlon2,nlat2,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(g2_mask(nlon2,nlat2), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the global grid
+  CALL read_grid_mask(nlon2,nlat2,nc, data_filename_g2, w_unit, tgt_grd_ini,  &
+                      ggrid2_lon,ggrid2_lat, &
+                      ggrid2_clo,ggrid2_cla, &
+                      g2_mask)
+
+  ! Mask inversion to follow (historical) OASIS3 convention (0=not masked;1=masked)
+  WHERE(g2_mask == 1) 
+      g2_mask=0
+  ELSEWHERE
+      g2_mask=1
+  END WHERE
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  WRITE grids.nc and masks.nc with both source and target grids
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL write_grids_masks(nlon1,nlat1,nlon2,nlat2,nc, &
+                         src_grd_end, tgt_grd_end, w_unit, &
+                         ggrid1_lon,ggrid1_lat,ggrid1_clo,ggrid1_cla,g1_mask, &
+                         ggrid2_lon,ggrid2_lat,ggrid2_clo,ggrid2_cla,g2_mask)
+  !
+  CLOSE (w_unit)
+  !
+END PROGRAM create_aux_files
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_dimgrid.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_dimgrid.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_dimgrid.F90	(revision 4775)
@@ -0,0 +1,77 @@
+!****************************************************************************************
+SUBROUTINE read_dimgrid (nlon,nlat,data_filename,w_unit,grid_name)
+  !**************************************************************************************
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit
+  !
+  INTEGER                  :: il_file_id,il_grid_id,il_lon_id, &
+     il_lat_id,il_indice_id, &
+     lon_dims,lat_dims,imask_dims
+  !
+  INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: lon_dims_ids,lat_dims_ids,&
+     imask_dims_ids,lon_dims_len,&
+     lat_dims_len,imask_dims_len  
+  !               
+  INTEGER, INTENT(out)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: grid_name
+  CHARACTER(len=8)         :: cl_nam_lon, cl_nam_lat, cl_nam_msk
+  !
+  ! Dimensions
+  !
+  cl_nam_lon=grid_name//".lon"
+  cl_nam_lat=grid_name//".lat"
+  cl_nam_msk=grid_name//".msk"
+  write(w_unit,*) 'cl_nam_lon :',cl_nam_lon
+  call flush(w_unit)
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_lon,  il_lon_id),    __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_lat,  il_lat_id),    __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_msk, il_indice_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(il_file_id, varid=il_lon_id, ndims=lon_dims, dimids=lon_dims_ids), __LINE__ )
+  !
+  ! The value lon_dims_len(i) is obtained thanks to the lon_dims_ids ID already obtained from the file
+  DO i=1,lon_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lon_dims_ids(i),len=lon_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  nlon=lon_dims_len(1)
+  nlat=lon_dims_len(2)
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(ncid=il_file_id, varid=il_lat_id, ndims=lat_dims, dimids=lat_dims_ids), __LINE__ )
+  !
+  ! The value lat_dims_len(i) is obtained thanks to the lat_dims_ids ID already obtained from the file
+  DO i=1,lat_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lat_dims_ids(i),len=lat_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  IF ( (lat_dims_len(1) .NE. lon_dims_len(1)).OR.(lat_dims_len(2) .NE. lon_dims_len(2)) ) THEN
+      WRITE(w_unit,*) 'Problem model1 in read_dimgrid'
+      WRITE(w_unit,*) 'Dimensions of the latitude are not the same as the ones of the longitude'
+      CALL flush(w_unit)
+      STOP
+  ENDIF
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(ncid=il_file_id, varid=il_indice_id, ndims=imask_dims, dimids=imask_dims_ids), __LINE__ )
+  !
+  ! The value imask_dims_len(i) is obtained thanks to the imask_dims_ids ID already obtained from the file
+  DO i=1,imask_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=imask_dims_ids(i),len=imask_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  CALL hdlerr(NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  WRITE(w_unit,*) 'Reading input file ',data_filename
+  WRITE(w_unit,*) 'Global dimensions nlon=',nlon,' nlat=',nlat
+  CALL FLUSH(w_unit)
+  !
+  !
+END SUBROUTINE read_dimgrid
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_grid_mask.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_grid_mask.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/read_grid_mask.F90	(revision 4775)
@@ -0,0 +1,99 @@
+  !****************************************************************************************
+  SUBROUTINE read_grid_mask (nlon,nlat,corners_ij_lus, &
+                             data_filename, w_unit, grid_name, &
+                             gridlon,gridlat, &
+                             gridclo,gridcla, &
+                             indice_mask)
+  !**************************************************************************************
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit
+  !
+  INTEGER                  :: il_file_id,il_grid_id,il_lon_id, &
+                              il_lat_id,il_clo_id,il_cla_id,il_srf_id,il_indice_id, &
+                              lon_dims,lat_dims,clo_dims,cla_dims,&
+                              imask_dims
+  !
+  INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: lon_dims_ids,lat_dims_ids,clo_dims_ids,&
+                                           cla_dims_ids,imask_dims_ids,lon_dims_len,&
+                                           lat_dims_len,clo_dims_len,cla_dims_len,&
+                                           imask_dims_len  
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat,corners_ij_lus
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: grid_name
+  CHARACTER(len=8)         :: cl_nam_lon, cl_nam_lat, cl_nam_msk, cl_nam_clo, cl_nam_cla
+  !
+  INTEGER,  DIMENSION(3)   :: ila_dim
+  INTEGER,  DIMENSION(3)   :: ila_corners,ila_what
+  !
+  DOUBLE PRECISION, DIMENSION(nlon,nlat)                :: gridlon,gridlat,gridsrf
+  DOUBLE PRECISION, DIMENSION(nlon,nlat,corners_ij_lus) :: gridclo,gridcla
+  INTEGER, DIMENSION(nlon,nlat)                      :: indice_mask
+  !
+  !
+  ! Dimensions
+  !
+  cl_nam_lon=grid_name//".lon"
+  cl_nam_clo=grid_name//".clo"
+  cl_nam_lat=grid_name//".lat"
+  cl_nam_cla=grid_name//".cla"
+  cl_nam_msk=grid_name//".msk"
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  !
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_lon, il_lon_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_lat, il_lat_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_clo, il_clo_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_cla, il_cla_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam_msk, il_indice_id), __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  ila_dim(3)=1
+  !
+  ila_corners(1)=nlon
+  ila_corners(2)=nlat
+  ila_corners(3)=corners_ij_lus
+  !
+  ! Data
+  !
+  CALL hdlerr( NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lon_id, gridlon, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global grid longitudes reading done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lat_id, gridlat, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global grid latitudes reading done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR(il_file_id, il_clo_id, gridclo, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global grid longitude corners reading done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_cla_id, gridcla, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global grid latitude corners reading done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_indice_id, indice_mask, &
+     ila_what, ila_dim), __LINE__ )
+  WRITE(w_unit,*) 'Global grid mask reading done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  WRITE(w_unit,*) 'End of routine read_grid'
+  CALL FLUSH(w_unit)
+  !
+END SUBROUTINE read_grid_mask
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/routine_hdlerr.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/routine_hdlerr.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/routine_hdlerr.F90	(revision 4775)
@@ -0,0 +1,19 @@
+!*********************************************************************************
+SUBROUTINE hdlerr(istatus, line)
+  !*********************************************************************************
+  use netcdf
+  implicit none
+  !
+  ! Check for error message from NetCDF call
+  !
+  integer, intent(in) :: istatus, line
+  integer             :: ierror
+  !
+  IF (istatus .NE. NF90_NOERR) THEN
+      write ( * , * ) 'NetCDF problem at line',line
+      write ( * , * ) 'Stopped '
+      STOP
+  ENDIF
+  !
+  RETURN
+END SUBROUTINE hdlerr
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/script_create_grids_masks_f90.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/script_create_grids_masks_f90.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/script_create_grids_masks_f90.sh	(revision 4775)
@@ -0,0 +1,44 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids in the initial files of each grid 
+export srcgridini=torc
+export tgtgridini=lmdz
+# Name of the files containing each grid
+export srcgridfile=grid_model1.nc
+export tgtgridfile=grid_model2.nc
+# Name of the grids in the final files grids_und.nc and masks_und.nc (4 characters)
+export srcgridend=tore
+export tgtgridend=lmde
+#
+# WARNING : the coordinates must be double and the masks must be integer 
+#
+RUNDIR=$HOMEDIR/wkdir_${srcgridend}_${tgtgridend}
+DATAGRIDS=$HOMEDIR/data
+#
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grid and mask files for each grid in $RUNDIR
+ln -sf $DATAGRIDS/${srcgridfile} $RUNDIR/${srcgridfile}
+ln -sf $DATAGRIDS/${tgtgridfile} $RUNDIR/${tgtgridfile}
+#
+# In case the variables are defined with "_" and not "."
+ncrename -v ${srcgridini}_lon,${srcgridini}.lon $srcgridfile
+ncrename -v ${srcgridini}_lat,${srcgridini}.lat $srcgridfile
+ncrename -v ${srcgridini}_clo,${srcgridini}.clo $srcgridfile
+ncrename -v ${srcgridini}_cla,${srcgridini}.cla $srcgridfile
+ncrename -v ${srcgridini}_msk,${srcgridini}.msk $srcgridfile
+#
+ncrename -v ${tgtgridini}_lon,${tgtgridini}.lon $tgtgridfile
+ncrename -v ${tgtgridini}_lat,${tgtgridini}.lat $tgtgridfile 
+ncrename -v ${tgtgridini}_clo,${tgtgridini}.clo $tgtgridfile
+ncrename -v ${tgtgridini}_cla,${tgtgridini}.cla $tgtgridfile
+ncrename -v ${tgtgridini}_msk,${tgtgridini}.msk $tgtgridfile
+#
+# Construct grids_und.nc and masks_und.nc files (with _) 
+echo "Running create_aux_files.ncl"
+cp $HOMEDIR/create_aux_files $RUNDIR/create_aux_files
+./create_aux_files $srcgridfile $tgtgridfile $srcgridini $tgtgridini $srcgridend $tgtgridend
+#
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/write_grids_masks.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/write_grids_masks.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_F90/write_grids_masks.F90	(revision 4775)
@@ -0,0 +1,177 @@
+  !****************************************************************************************
+  SUBROUTINE write_grids_masks (nlon1,nlat1,nlon2,nlat2,corners_ij, &
+                               grids_name, gridt_name, w_unit, &
+                               gridlon1,gridlat1, gridclo1,gridcla1, indice_mask1, &
+                               gridlon2,gridlat2, gridclo2,gridcla2, indice_mask2)
+  !**************************************************************************************
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit
+  !
+  INTEGER                  :: LONID1, LATID1, LONID2, LATID2, CC1, CC2
+  INTEGER                  :: il_file_id,il_lon_id1, &
+                              il_lat_id1,il_clo_id1,il_cla_id1,il_indice_id1, &
+                              il_lon_id2,il_lat_id2,il_clo_id2,il_cla_id2,il_indice_id2
+  !               
+  INTEGER, INTENT(in)     :: nlon1,nlat1,nlon2,nlat2,corners_ij
+  !
+  CHARACTER(len=4)         :: grids_name,gridt_name
+  CHARACTER(len=8)         :: cl1_nam_lon, cl1_nam_lat, cl1_nam_msk, cl1_nam_clo, cl1_nam_cla
+  CHARACTER(len=8)         :: cl2_nam_lon, cl2_nam_lat, cl2_nam_msk, cl2_nam_clo, cl2_nam_cla
+  !
+  INTEGER,  DIMENSION(3)   :: ila_dim
+  INTEGER,  DIMENSION(3)   :: ila_corners,ila_what
+  !
+  DOUBLE PRECISION, DIMENSION(nlon1,nlat1)                :: gridlon1,gridlat1
+  DOUBLE PRECISION, DIMENSION(nlon1,nlat1,corners_ij) :: gridclo1,gridcla1
+  INTEGER,          DIMENSION(nlon1,nlat1)                :: indice_mask1
+  DOUBLE PRECISION, DIMENSION(nlon2,nlat2)                :: gridlon2,gridlat2
+  DOUBLE PRECISION, DIMENSION(nlon2,nlat2,corners_ij) :: gridclo2,gridcla2
+  INTEGER,          DIMENSION(nlon2,nlat2)                :: indice_mask2
+  !
+  !
+  ! Dimensions
+  !
+  cl1_nam_lon=grids_name//".lon"
+  cl1_nam_clo=grids_name//".clo"
+  cl1_nam_lat=grids_name//".lat"
+  cl1_nam_cla=grids_name//".cla"
+  cl1_nam_msk=grids_name//".msk"
+  !
+  cl2_nam_lon=gridt_name//".lon"
+  cl2_nam_clo=gridt_name//".clo"
+  cl2_nam_lat=gridt_name//".lat"
+  cl2_nam_cla=gridt_name//".cla"
+  cl2_nam_msk=gridt_name//".msk"
+  !
+  !
+  CALL hdlerr(NF90_CREATE('grids.nc', NF90_CLOBBER, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon1", nlon1, LONID1), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat1", nlat1, LATID1), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "crn1", corners_ij, CC1), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon2", nlon2, LONID2), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat2", nlat2, LATID2), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "crn2", corners_ij, CC2), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_lon, NF90_REAL, (/LONID1, LATID1/), il_lon_id1), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_lat, NF90_REAL, (/LONID1, LATID1/), il_lat_id1), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_clo, NF90_REAL, (/LONID1, LATID1, CC1/), il_clo_id1), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_cla, NF90_REAL, (/LONID1, LATID1, CC1/), il_cla_id1), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_lon, NF90_REAL, (/LONID2, LATID2/), il_lon_id2), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_lat, NF90_REAL, (/LONID2, LATID2/), il_lat_id2), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_clo, NF90_REAL, (/LONID2, LATID2, CC2/), il_clo_id2), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_cla, NF90_REAL, (/LONID2, LATID2, CC2/), il_cla_id2), __LINE__ )
+  !
+  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon1
+  ila_dim(2)=nlat1
+  ila_dim(3)=1
+  !
+  ila_corners(1)=nlon1
+  ila_corners(2)=nlat1
+  ila_corners(3)=corners_ij
+  !
+  ! Write Data in grids.nc 
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id1, gridlon1, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global source grid longitudes writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id1, gridlat1, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global source grid latitudes writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_clo_id1, gridclo1, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global source grid clo writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_cla_id1, gridcla1, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global source grid cla writing done'
+  CALL FLUSH(w_unit)
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon2
+  ila_dim(2)=nlat2
+  ila_dim(3)=1
+  !
+  ila_corners(1)=nlon2
+  ila_corners(2)=nlat2
+  ila_corners(3)=corners_ij
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id2, gridlon2, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global target grid longitudes writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id2, gridlat2, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global target grid latitudes writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_clo_id2, gridclo2, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global target grid clo writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_cla_id2, gridcla2, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global target grid cla writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  !
+  CALL hdlerr(NF90_CREATE('masks.nc', NF90_CLOBBER, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon1", nlon1, LONID1), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat1", nlat1, LATID1), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon2", nlon2, LONID2), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat2", nlat2, LATID2), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl1_nam_msk, NF90_INT, (/LONID1, LATID1/), il_indice_id1), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, cl2_nam_msk, NF90_INT, (/LONID2, LATID2/), il_indice_id2), __LINE__ )
+  !
+  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon1
+  ila_dim(2)=nlat1
+  ila_dim(3)=1
+  !
+  ! Write Data in masks.nc 
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_indice_id1, indice_mask1, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global source grid mask writing done'
+  CALL FLUSH(w_unit)
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon2
+  ila_dim(2)=nlat2
+  ila_dim(3)=1
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_indice_id2, indice_mask2, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global target grid mask writing done'
+  CALL FLUSH(w_unit)
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  WRITE(w_unit,*) 'End of routine write_grids_masks'
+  CALL FLUSH(w_unit)
+  !
+END SUBROUTINE write_grids_masks
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/create_aux_files.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/create_aux_files.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/create_aux_files.ncl	(revision 4775)
@@ -0,0 +1,89 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"   
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"   
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/shea_util.ncl"
+
+; ================================================;
+begin
+
+PATH1 = "./"
+PATH2 = "./"
+
+;--------------------------------------------
+;--- Source and Target grid Files
+;--------------------------------------------
+  print("Source grid "+srcgridfile) 
+  print("Target grid "+tgtgridfile) 
+
+;--------------------------------------------
+;--- Coordinate names
+;--------------------------------------------
+  srcgrdlonini = srcgridini+"_lon"
+  srcgrdlatini = srcgridini+"_lat"
+  srcgrdcloini = srcgridini+"_clo"
+  srcgrdclaini = srcgridini+"_cla"
+  srcgrdmskini = srcgridini+"_msk"
+  tgtgrdlonini = tgtgridini+"_lon"
+  tgtgrdlatini = tgtgridini+"_lat"
+  tgtgrdcloini = tgtgridini+"_clo"
+  tgtgrdclaini = tgtgridini+"_cla"
+  tgtgrdmskini = tgtgridini+"_msk"
+;
+  srcgrdlonend = srcgridend+"_lon"
+  srcgrdlatend = srcgridend+"_lat"
+  srcgrdcloend = srcgridend+"_clo"
+  srcgrdclaend = srcgridend+"_cla"
+  srcgrdmskend = srcgridend+"_msk"
+  tgtgrdlonend = tgtgridend+"_lon"
+  tgtgrdlatend = tgtgridend+"_lat"
+  tgtgrdcloend = tgtgridend+"_clo"
+  tgtgrdclaend = tgtgridend+"_cla"
+  tgtgrdmskend = tgtgridend+"_msk"
+
+;--------------------------------------------
+;--- Output Files
+;--------------------------------------------
+  grids  = PATH2+"grids_und.nc"     ; File with the source and target grids
+  masks  = PATH2+"masks_und.nc"     ; File with the source and target masks
+
+;--------------------------------------------
+;--- Cleaning: remove any pre-existing file
+;-------------------------------------------- 
+  system("/bin/rm -f "+grids)
+  system("/bin/rm -f "+masks)
+
+;------------------------------------------------------------
+;--- read the data of each model and write the output files
+;------------------------------------------------------------
+
+fi1 = addfile(srcgridfile,"r")
+fi2 = addfile(tgtgridfile,"r")
+
+fo1 = addfile(grids,"c")
+fo1@creation_date=systemfunc("date")
+fo1@title="Training OASIS3-MCT CERFACS"
+
+fo2 = addfile(masks,"c")
+fo2@creation_date=systemfunc("date")
+fo2@title="Training OASIS3-MCT CERFACS"
+
+fo1->$srcgrdlonend$=fi1->$srcgrdlonini$
+fo1->$srcgrdlatend$=fi1->$srcgrdlatini$
+fo1->$srcgrdcloend$=fi1->$srcgrdcloini$
+fo1->$srcgrdclaend$=fi1->$srcgrdclaini$
+
+fo1->$tgtgrdlonend$=fi2->$tgtgrdlonini$
+fo1->$tgtgrdlatend$=fi2->$tgtgrdlatini$
+fo1->$tgtgrdcloend$=fi2->$tgtgrdcloini$
+fo1->$tgtgrdclaend$=fi2->$tgtgrdclaini$
+
+;--- In the initial files, the mask is 1 for valid points (ocean) and 0 for masked points (land)
+;--- For OASIS3-MCT, it is necessary to have 0 for valid points (ocean) and 1 for masked points (land) (old convention)
+
+srcmsk=fi1->$srcgrdmskini$
+tgtmsk=fi2->$tgtgrdmskini$
+
+fo2->$srcgrdmskend$=1-srcmsk
+fo2->$tgtgrdmskend$=1-tgtmsk
+
+end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/script_create_grids_masks_ncl.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/script_create_grids_masks_ncl.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/create_grids_masks_with_NCL/script_create_grids_masks_ncl.sh	(revision 4775)
@@ -0,0 +1,59 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids in the initial files of each grid 
+srcgridini=bt42
+tgtgridini=lmdz
+# Name of the files containing each grid
+srcgridfile=grid_model1.nc
+tgtgridfile=grid_model2.nc
+# Name of the grids in the final files grids_und.nc and masks_und.nc (4 characters)
+srcgridend=bt42
+tgtgridend=lmde
+#
+# WARNING : the coordinates must be double and the masks must be integer 
+#
+RUNDIR=$HOMEDIR/wkdir_${srcgridend}_${tgtgridend}
+DATAGRIDS=$HOMEDIR/data
+#
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grid and mask files for each grid in $RUNDIR
+ln -sf $DATAGRIDS/${srcgridfile} $RUNDIR/${srcgridfile}
+ln -sf $DATAGRIDS/${tgtgridfile} $RUNDIR/${tgtgridfile}
+#
+# In case variables are defined with "." and not with "_"
+ncrename -v ${srcgridini}.lon,${srcgridini}_lon $srcgridfile
+ncrename -v ${srcgridini}.lat,${srcgridini}_lat $srcgridfile
+ncrename -v ${srcgridini}.clo,${srcgridini}_clo $srcgridfile
+ncrename -v ${srcgridini}.cla,${srcgridini}_cla $srcgridfile
+ncrename -v ${srcgridini}.msk,${srcgridini}_msk $srcgridfile
+#
+ncrename -v ${tgtgridini}.lon,${tgtgridini}_lon $tgtgridfile
+ncrename -v ${tgtgridini}.lat,${tgtgridini}_lat $tgtgridfile 
+ncrename -v ${tgtgridini}.clo,${tgtgridini}_clo $tgtgridfile
+ncrename -v ${tgtgridini}.cla,${tgtgridini}_cla $tgtgridfile
+ncrename -v ${tgtgridini}.msk,${tgtgridini}_msk $tgtgridfile
+#
+# Construct grids_und.nc and masks_und.nc files (with _) 
+echo "Running create_aux_files.ncl"
+cp $HOMEDIR/create_aux_files.ncl $RUNDIR/create_aux_files.ncl
+ncl 'srcgridfile="'${srcgridfile}'"' 'tgtgridfile="'${tgtgridfile}'"' 'srcgridini="'${srcgridini}'"' 'tgtgridini="'${tgtgridini}'"' 'srcgridend="'${srcgridend}'"' 'tgtgridend="'${tgtgridend}'"' create_aux_files.ncl
+#
+# Change names of variable and files for OASIS3-MCT
+cp grids_und.nc grids.nc
+cp masks_und.nc masks.nc
+
+ncrename -v ${srcgridend}_lon,${srcgridend}.lon grids.nc
+ncrename -v ${srcgridend}_lat,${srcgridend}.lat grids.nc
+ncrename -v ${srcgridend}_clo,${srcgridend}.clo grids.nc
+ncrename -v ${srcgridend}_cla,${srcgridend}.cla grids.nc
+ncrename -v ${srcgridend}_msk,${srcgridend}.msk masks.nc
+#
+ncrename -v ${tgtgridend}_lon,${tgtgridend}.lon grids.nc
+ncrename -v ${tgtgridend}_lat,${tgtgridend}.lat grids.nc 
+ncrename -v ${tgtgridend}_clo,${tgtgridend}.clo grids.nc
+ncrename -v ${tgtgridend}_cla,${tgtgridend}.cla grids.nc
+ncrename -v ${tgtgridend}_msk,${tgtgridend}.msk masks.nc
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/cf_name_table.txt
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/cf_name_table.txt	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/cf_name_table.txt	(revision 4775)
@@ -0,0 +1,425 @@
+# Maximum index of the table entries, total number of indices
+465 422
+#Index, CF longname, unit
+ 1  'sea_surface_temperature' 'K'
+ 2  'sea_ice_extent' 'm2'
+ 3  'upward_grid_eastward_stress_at_sea_ice_base' 'Pa'
+ 4  'upward_grid_northward_stress_at_sea_ice_base' 'Pa'
+ 5  'surface_downward_heat_flux' 'W m-2'
+ 6  'surface_downward_non_shortwave_heat_flux' 'W m-2'
+ 7  'surface_net_downward_shortwave_flux' 'W m-2'
+ 8  'surface_downward_latent_heat_flux' 'W m-2'
+ 9  'surface_downward_sensible_heat_flux' 'W m-2'
+ 10  'surface_net_downward_longwave_flux' 'W m-2'
+ 11  'surface_net_downward_direct_shortwave_flux' 'W m-2'
+ 12  'surface_net_downward_diffusive_shortwave_flux' 'W m-2'
+ 13  'surface_upwelling_downward_shortwave_flux' 'W m-2'
+ 14  'surface_upwelling_downward_longwave_flux' 'W m-2'
+ 15  'surface_downwelling_downward_longwave_flux' 'W m-2'
+ 16  'surface_emissivity' '1'
+ 17  'surface_albedo' '1'
+ 18  'surface_snow_area_fraction' '1'
+ 19  'lower_level_air_temperature' 'K'
+ 20  'lower_level_wind_module' 'Pa'
+ 21  'lower_level_geopotential' 'm2 s-2'
+ 22  'lower_level_specific_humidity' '1'
+ 23  'surface_downward_grid_eastward_stress' 'Pa'
+ 24  'surface_downward_grid_northward_stress' 'Pa'
+ 25  'water_evaporation_flux' '1'
+ 26  'surface_precipitation_flux' 'kg m-2 s-1'
+ 27  'rainfall_flux' 'kg m-2 s-1'
+ 28  'snow_fall_flux' 'kg m-2 s-1'
+ 29  'water_flux_into_ocean' 'kg m-2 s-1'
+ 30  'surface_downward_water_flux' 'kg m-2 s-1'
+ 31  'sea_ice_area_fraction' '1'
+ 32  'water_flux_into_ocean_from_rivers' 'kg m-2 s-1'
+ 33  'surface_air_pressure' 'Pa'
+ 34  'surface_temperature' 'K'
+ 35  'surface_downward_non_shortwave_heat_flux_derivative' 'W m-2'
+ 36  'water_flux_into_ocean_from_ice_sheet' 'kg m-2 s-1'
+ 37  'surface_energy_flux_into_ocean_due_to_wind_mixing' 'W m-2'
+ 38  'surface_net_downward_shortwave_flux' 'W m-2'
+ 39  'surface_downward_non_penetrative_heat_flux' 'W m-2'
+ 40  'snow_fall_flux' 'kg m-2 s-1'
+ 41  'water_evaporation_flux_where_sea_ice' 'kg m-2 s-1'
+ 42  'downward_heat_flux_in_sea_ice' 'W m-2'
+ 43  'surface_melt_heat_flux' 'W m-2'
+ 44  'sea_ice_area_fraction' '1'
+ 45  'sea_ice_thickness' '1'
+ 46  'lwe_snow_thickness_where_sea_ice' 'm'
+ 47  'surface_grid_eastward_sea_water_velocity' 'm s-1'
+ 48  'surface_grid_northward_sea_water_velocity' 'm s-1'
+ 49  'chemical concentration' '1e-6'
+ 50  'surface_downward_grid_eastward_stress_where_open_sea' 'Pa'
+ 51  'surface_downward_grid_northward_stress_where_open_sea' 'Pa'
+ 52  'surface_downward_grid_eastward_stress_where_sea_ice' 'Pa'
+ 53  'surface_downward_grid_northward_stress_where_sea_ice' 'Pa'
+ 54  'lower_level_relative_humidity' '1'
+ 55  'lwe_surface_downward_snow_flux_where_sea_ice' 'kg m-2 s-1'
+ 56  'wind_speed_at_10m' 'm s-1'
+ 100  'air_density' 'kg m-3'
+ 101  'air_potential_temperature' 'K'
+ 102  'air_pressure' 'Pa'
+ 103  'air_pressure_anomaly' 'Pa'
+ 104  'air_pressure_at_cloud_base' 'Pa'
+ 105  'air_pressure_at_cloud_top' 'Pa'
+ 106  'air_pressure_at_convective_cloud_base' 'Pa'
+ 107  'air_pressure_at_convective_cloud_top' 'Pa'
+ 108  'air_pressure_at_freezing_level' 'Pa'
+ 109  'air_pressure_at_sea_level' 'Pa'
+ 110  'air_temperature' 'K'
+ 111  'air_temperature_anomaly' 'K'
+ 112  'air_temperature_lapse_rate' 'K m-1'
+ 113  'altitude' 'm'
+ 114  'area_fraction_below_surface' '1'
+ 115  'atmosphere_absolute_vorticity' 's-1'
+ 116  'atmosphere_boundary_layer_thickness' 'm'
+ 117  'atmosphere_cloud_condensed_water_content' 'kg m-2'
+ 118  'atmosphere_cloud_ice_content' 'kg m-2'
+ 119  'atmosphere_cloud_liquid_water_content' 'kg m-2'
+ 120  'atmosphere_eastward_stress_due_to_gravity_wave_drag' 'Pa'
+ 121  'atmosphere_energy_content' 'J m-2'
+ 122  'atmosphere_horizontal_streamfunction' 'm2 s-1'
+ 123  'atmosphere_horizontal_velocity_potential' 'm2 s-1'
+ 124  'atmosphere_hybrid_height_coordinate' 'm'
+ 125  'atmosphere_hybrid_sigma_pressure_coordinate' '1'
+ 126  'atmosphere_kinetic_energy_content' 'J m-2'
+ 127  'atmosphere_northward_stress_due_to_gravity_wave_drag' 'Pa'
+ 128  'atmosphere_relative_vorticity' 's-1'
+ 129  'atmosphere_sigma_coordinate' '1'
+ 130  'atmosphere_so4_content' 'kg m-2'
+ 131  'atmosphere_surface_drag_coefficient' '1'
+ 132  'atmosphere_water_content' 'kg m-2'
+ 133  'atmosphere_water_vapor_content' 'kg m-2'
+ 134  'baroclinic_eastward_sea_water_velocity' 'm s-1'
+ 135  'baroclinic_northward_sea_water_velocity' 'm s-1'
+ 136  'barotropic_eastward_sea_water_velocity' 'm s-1'
+ 137  'barotropic_northward_sea_water_velocity' 'm s-1'
+ 138  'brightness_temperature' 'K'
+ 139  'brunt_vaisala_frequency_in_air' 's-1'
+ 140  'canopy_height' 'm'
+ 141  'canopy_water_amount' 'kg m-2'
+ 142  'chlorophyll_concentration_in_sea_water' 'kg m-3'
+ 143  'cloud_area_fraction' '1'
+ 144  'cloud_area_fraction_in_atmosphere_layer' '1'
+ 145  'cloud_base_altitude' 'm'
+ 146  'cloud_condensed_water_content_of_atmosphere_layer' 'kg m-2'
+ 147  'cloud_ice_content_of_atmosphere_layer' 'kg m-2'
+ 148  'cloud_liquid_water_content_of_atmosphere_layer' 'kg m-2'
+ 149  'cloud_top_altitude' 'm'
+ 150  'convective_cloud_area_fraction' '1'
+ 151  'convective_precipitation_amount' 'kg m-2'
+ 152  'convective_precipitation_flux' 'kg m-2 s-1'
+ 153  'convective_rainfall_amount' 'kg m-2'
+ 154  'convective_rainfall_flux' 'kg m-2 s-1'
+ 155  'convective_rainfall_rate' 'm s-1'
+ 156  'convective_snowfall_amount' 'kg m-2'
+ 157  'convective_snowfall_flux' 'kg m-2 s-1'
+ 158  'depth' 'm'
+ 159  'dew_point_depression' 'K'
+ 160  'dew_point_temperature' 'K'
+ 161  'dimensionless_exner_function' '1'
+ 162  'direction_of_sea_ice_velocity' 'degree'
+ 163  'direction_of_sea_water_velocity' 'degree'
+ 164  'direction_of_swell_wave_velocity' 'degree'
+ 165  'direction_of_wind_wave_velocity' 'degree'
+ 166  'dissipation_in_atmosphere_boundary_layer' 'W m-2'
+ 167  'divergence_of_sea_ice_velocity' 's-1'
+ 168  'divergence_of_wind' 's-1'
+ 169  'downward_eastward_momentum_flux_in_air' 'Pa'
+ 170  'downward_eastward_stress_at_sea_ice_base' 'Pa'
+ 171  'downward_heat_flux_in_air' 'W m-2'
+ 172  'downward_heat_flux_in_sea_ice' 'W m-2'
+ 173  'downward_heat_flux_in_soil' 'W m-2'
+ 174  'downward_northward_momentum_flux_in_air' 'Pa'
+ 175  'downward_northward_stress_at_sea_ice_base' 'Pa'
+ 176  'downwelling_photosynthetic_photon_flux_in_sea_water' 'mol m-2 s-1'
+ 177  'downwelling_spectral_radiative_flux_in_air' 'W m-2 m-1'
+ 178  'downwelling_spectral_radiative_flux_in_sea_water' 'W m-2 m-1'
+ 179  'eastward_momentum_flux_correction' 'Pa'
+ 180  'eastward_sea_ice_velocity' 'm s-1'
+ 181  'eastward_sea_water_velocity' 'm s-1'
+ 182  'eastward_wind' 'm s-1'
+ 183  'eastward_wind_shear' 's-1'
+ 184  'electromagnetic_wavelength' 'm'
+ 185  'equivalent_potential_temperature' 'K'
+ 186  'equivalent_temperature' 'K'
+ 187  'equivalent_thickness_at_stp_of_atmosphere_o3_content' 'm'
+ 188  'ertel_potential_vorticity' 'K m2 kg-1 s-1'
+ 189  'forecast_period' 's'
+ 190  'forecast_reference_time' 's'
+ 191  'freezing_level_altitude' 'm'
+ 192  'freezing_temperature_of_sea_water' 'K'
+ 193  'frozen_water_content_of_soil_layer' 'kg m-2'
+ 194  'geopotential' 'm2 s-2'
+ 195  'geopotential_height' 'm'
+ 196  'geopotential_height_anomaly' 'm'
+ 197  'grid_eastward_wind' 'm s-1'
+ 198  'grid_latitude' 'degree'
+ 199  'grid_longitude' 'degree'
+ 200  'grid_northward_wind' 'm s-1'
+ 201  'gross_primary_productivity_of_carbon' 'kg m-2 s-1'
+ 202  'heat_flux_correction' 'W m-2'
+ 203  'height' 'm'
+ 204  'height_at_cloud_top' 'm'
+ 205  'humidity_mixing_ratio' '1'
+ 206  'land_area_fraction' '1'
+ 207  'land_binary_mask' '1'
+ 208  'land_ice_area_fraction' '1'
+ 209  'large_scale_cloud_area_fraction' '1'
+ 210  'large_scale_precipitation_amount' 'kg m-2'
+ 211  'large_scale_rainfall_amount' 'kg m-2'
+ 212  'large_scale_rainfall_flux' 'kg m-2 s-1'
+ 213  'large_scale_rainfall_rate' 'm s-1'
+ 214  'large_scale_snowfall_amount' 'kg m-2'
+ 215  'large_scale_snowfall_flux' 'kg m-2 s-1'
+ 216  'latitude' 'degree_north'
+ 217  'leaf_area_index' '1'
+ 218  'litter_carbon_flux' 'kg m-2 s-1'
+ 219  'longitude' 'degree_east'
+ 220  'longwave_radiance' 'W m-2 sr-1'
+ 221  'lwe_convective_precipitation_rate' 'm s-1'
+ 222  'lwe_convective_snowfall_rate' 'm s-1'
+ 223  'lwe_large_scale_precipitation_rate' 'm s-1'
+ 224  'lwe_large_scale_snowfall_rate' 'm s-1'
+ 225  'lwe_precipitation_rate' 'm s-1'
+ 226  'lwe_snowfall_rate' 'm s-1'
+ 227  'lwe_thickness_of_atmosphere_water_vapor_content' 'm'
+ 228  'lwe_thickness_of_canopy_water_amount' 'm'
+ 229  'lwe_thickness_of_convective_precipitation_amount' 'm'
+ 230  'lwe_thickness_of_large_scale_precipitation_amount' 'm'
+ 231  'lwe_thickness_of_moisture_content_of_soil_layer' 'm'
+ 232  'lwe_thickness_of_snowfall_amount' 'm'
+ 233  'lwe_thickness_of_soil_moisture_content' 'm'
+ 234  'lwe_thickness_of_surface_snow_amount' 'm'
+ 235  'lwe_thickness_of_water_evaporation_amount' 'm'
+ 236  'lwe_water_evaporation_rate' 'm s-1'
+ 237  'mass_fraction_of_cloud_ice_in_air' '1'
+ 238  'mass_fraction_of_cloud_liquid_water_in_air' '1'
+ 239  'mass_fraction_of_convective_condensed_water_in_air' '1'
+ 240  'mass_fraction_of_frozen_water_in_soil_moisture' '1'
+ 241  'mass_fraction_of_o3_in_air' '1'
+ 242  'mass_fraction_of_unfrozen_water_in_soil_moisture' '1'
+ 243  'mass_fraction_of_water_in_air' '1'
+ 244  'mass_mixing_ratio' '1'
+ 245  'mass_transport' 'kg s-1'
+ 246  'model_level_number' '1'
+ 247  'moisture_content_of_soil_layer' 'kg m-2'
+ 248  'mole_fraction_of_o3_in_air' '1'
+ 249  'net_downward_longwave_flux_in_air' 'W m-2'
+ 250  'net_downward_radiative_flux_at_top_of_atmosphere_model' 'W m-2'
+ 251  'net_downward_shortwave_flux_in_air' 'W m-2'
+ 252  'net_primary_productivity_of_carbon' 'kg m-2 s-1'
+ 253  'net_upward_longwave_flux_in_air' 'W m-2'
+ 254  'net_upward_shortwave_flux_in_air' 'W m-2'
+ 255  'northward_atmosphere_heat_transport' 'W'
+ 256  'northward_momentum_flux_correction' 'Pa'
+ 257  'northward_ocean_freshwater_transport' 'kg s-1'
+ 258  'northward_ocean_heat_transport' 'W'
+ 259  'northward_ocean_salt_transport' 'kg s-1'
+ 260  'northward_sea_ice_velocity' 'm s-1'
+ 261  'northward_sea_water_velocity' 'm s-1'
+ 262  'northward_wind' 'm s-1'
+ 263  'northward_wind_shear' 's-1'
+ 264  'ocean_barotropic_streamfunction' 'm3 s-1'
+ 265  'ocean_isopycnal_layer_thickness_diffusivity' 'm2 s-1'
+ 266  'ocean_meridional_overturning_streamfunction' 'm3 s-1'
+ 267  'ocean_mixed_layer_thickness' 'm'
+ 268  'ocean_s_coordinate' '1'
+ 269  'ocean_sigma_coordinate' '1'
+ 270  'omega' 'Pa s-1'
+ 271  'planetary_albedo' '1'
+ 272  'plant_respiration_carbon_flux' 'kg m-2 s-1'
+ 273  'potential_vorticity_of_atmosphere_layer' 'Pa-1 s-1'
+ 274  'potential_vorticity_of_ocean_layer' 'm-1 s-1'
+ 275  'precipitation_amount' 'kg m-2'
+ 276  'precipitation_flux' 'kg m-2 s-1'
+ 277  'product_of_eastward_wind_and_air_temperature' 'K m s-1'
+ 278  'product_of_eastward_wind_and_geopotential_height' 'm2 s-1'
+ 279  'product_of_eastward_wind_and_northward_wind' 'm2 s-2'
+ 280  'product_of_eastward_wind_and_omega' 'Pa m s-2'
+ 281  'product_of_eastward_wind_and_specific_humidity' 'm s-1'
+ 282  'product_of_northward_wind_and_air_temperature' 'K m s-1'
+ 283  'product_of_northward_wind_and_geopotential_height' 'm2 s-1'
+ 284  'product_of_northward_wind_and_omega' 'Pa m s-2'
+ 285  'product_of_northward_wind_and_specific_humidity' 'm s-1'
+ 286  'product_of_omega_and_air_temperature' 'K Pa s-1'
+ 287  'product_of_omega_and_specific_humidity' 'Pa s-1'
+ 288  'projection_x_coordinate' 'm'
+ 289  'projection_y_coordinate' 'm'
+ 290  'pseudo_equivalent_potential_temperature' 'K'
+ 291  'pseudo_equivalent_temperature' 'K'
+ 292  'rainfall_flux' 'kg m-2 s-1'
+ 293  'rainfall_rate' 'm s-1'
+ 294  'region' 'string'
+ 295  'relative_humidity' '1'
+ 296  'root_depth' 'm'
+ 297  'runoff_flux' 'kg m-2 s-1'
+ 298  'sea_area_fraction' '1'
+ 299  'sea_floor_depth' 'm'
+ 300  'sea_ice_amount' 'kg m-2'
+ 301  'sea_ice_area' 'm2'
+ 302  'sea_ice_area_fraction' '1'
+ 303  'sea_ice_draft' 'm'
+ 304  'sea_ice_extent' 'm2'
+ 305  'sea_ice_freeboard' 'm'
+ 306  'sea_ice_mass' 'kg'
+ 307  'sea_ice_speed' 'm s-1'
+ 308  'sea_ice_thickness' 'm'
+ 309  'sea_ice_volume' 'm3'
+ 310  'sea_surface_elevation' 'm'
+ 311  'sea_surface_elevation_anomaly' 'm'
+ 312  'sea_surface_salinity' '1e-3'
+ 313  'sea_surface_temperature' 'K'
+ 314  'sea_water_density' 'kg m-3'
+ 315  'sea_water_electrical_conductivity' 'S m-1'
+ 316  'sea_water_potential_density' 'kg m-3'
+ 317  'sea_water_potential_temperature' 'K'
+ 318  'sea_water_salinity' '1e-3'
+ 319  'sea_water_sigma_t' 'kg m-3'
+ 320  'sea_water_sigma_theta' 'kg m-3'
+ 321  'sea_water_speed' 'm s-1'
+ 322  'sea_water_temperature' 'K'
+ 323  'shortwave_radiance' 'W m-2 sr-1'
+ 324  'significant_height_of_swell_waves' 'm'
+ 325  'significant_height_of_wind_and_swell_waves' 'm'
+ 326  'significant_height_of_wind_waves' 'm'
+ 327  'snowfall_amount' 'kg m-2'
+ 328  'snowfall_flux' 'kg m-2 s-1'
+ 329  'snow_grain_size' 'm'
+ 330  'snow_soot_content' 'kg m-2'
+ 331  'snow_temperature' 'K'
+ 332  'soil_albedo' '1'
+ 333  'soil_carbon_content' 'kg m-2'
+ 334  'soil_frozen_water_content' 'kg m-2'
+ 335  'soil_moisture_content' 'kg m-2'
+ 336  'soil_moisture_content_at_field_capacity' 'kg m-2'
+ 337  'soil_temperature' 'K'
+ 338  'specific_convective_available_potential_energy' 'J kg-1'
+ 339  'specific_humidity' '1'
+ 340  'specific_potential_energy' 'J kg-1'
+ 341  'spectral_radiance' 'W m-2 m-1 sr-1'
+ 342  'square_of_air_temperature' 'K2'
+ 343  'square_of_brunt_vaisala_frequency_in_air' 's-2'
+ 344  'square_of_eastward_wind' 'm2 s-2'
+ 345  'square_of_northward_wind' 'm2 s-2'
+ 346  'subsurface_runoff_amount' 'kg m-2'
+ 347  'subsurface_runoff_flux' 'kg m-2 s-1'
+ 348  'surface_air_pressure' 'Pa'
+ 349  'surface_albedo' '1'
+ 350  'surface_albedo_assuming_deep_snow' '1'
+ 351  'surface_albedo_assuming_no_snow' '1'
+ 352  'surface_altitude' 'm'
+ 353  'surface_downward_eastward_stress' 'Pa'
+ 354  'surface_downward_heat_flux_in_air' 'W m-2'
+ 355  'surface_downward_latent_heat_flux' 'W m-2'
+ 356  'surface_downward_northward_stress' 'Pa'
+ 357  'surface_downward_sensible_heat_flux' 'W m-2'
+ 358  'surface_downward_water_flux' 'kg m-2 s-1'
+ 359  'surface_downwelling_longwave_flux' 'W m-2'
+ 360  'surface_downwelling_longwave_flux_assuming_clear_sky' 'W m-2'
+ 361  'surface_downwelling_photosynthetic_photon_flux_in_sea_water' 'mol m-2 s-1'
+ 362  'surface_downwelling_shortwave_flux' 'W m-2'
+ 363  'surface_downwelling_shortwave_flux_assuming_clear_sky' 'W m-2'
+ 364  'surface_downwelling_spectral_radiative_flux_in_air' 'W m-2 m-1'
+ 365  'surface_downwelling_spectral_radiative_flux_in_sea_water' 'W m-2 m-1'
+ 366  'surface_net_downward_longwave_flux' 'W m-2'
+ 367  'surface_net_downward_shortwave_flux' 'W m-2'
+ 368  'surface_net_upward_longwave_flux' 'W m-2'
+ 369  'surface_net_upward_shortwave_flux' 'W m-2'
+ 370  'surface_roughness_length' 'm'
+ 371  'surface_runoff_amount' 'kg m-2'
+ 372  'surface_runoff_flux' 'kg m-2 s-1'
+ 373  'surface_snow_amount' 'kg m-2'
+ 374  'surface_snow_area_fraction' '1'
+ 375  'surface_snow_melt_amount' 'kg m-2'
+ 376  'surface_snow_melt_flux' 'kg m-2 s-1'
+ 377  'surface_snow_melt_heat_flux' 'W m-2'
+ 378  'surface_snow_thickness' 'm'
+ 379  'surface_snow_thickness_where_sea_ice' 'm'
+ 380  'surface_temperature' 'K'
+ 381  'surface_temperature_anomaly' 'K'
+ 382  'surface_upward_heat_flux_in_air' 'W m-2'
+ 383  'surface_upward_latent_heat_flux' 'W m-2'
+ 384  'surface_upward_sensible_heat_flux' 'W m-2'
+ 385  'surface_upward_water_flux' 'kg m-2 s-1'
+ 386  'surface_upwelling_longwave_flux' 'W m-2'
+ 387  'surface_upwelling_longwave_flux_assuming_clear_sky' 'W m-2'
+ 388  'surface_upwelling_shortwave_flux' 'W m-2'
+ 389  'surface_upwelling_shortwave_flux_assuming_clear_sky' 'W m-2'
+ 390  'surface_upwelling_spectral_radiative_flux_in_air' 'W m-2 m-1'
+ 391  'surface_upwelling_spectral_radiative_flux_in_sea_water' 'W m-2 m-1'
+ 392  'swell_wave_period' 's'
+ 393  'tendency_of_air_pressure' 'Pa s-1'
+ 394  'tendency_of_air_temperature_due_to_diabatic_processes' 'K s-1'
+ 395  'tendency_of_air_temperature_due_to_dry_convection' 'K s-1'
+ 396  'tendency_of_air_temperature_due_to_large_scale_precipitation' 'K s-1'
+ 397  'tendency_of_air_temperature_due_to_longwave_heating' 'K s-1'
+ 398  'tendency_of_air_temperature_due_to_longwave_heating_assuming' 'K s-1'
+ 399  'tendency_of_air_temperature_due_to_moist_convection' 'K s-1'
+ 400  'tendency_of_air_temperature_due_to_shortwave_heating' 'K s-1'
+ 401  'tendency_of_air_temperature_due_to_shortwave_heating_assumin' 'K s-1'
+ 402  'tendency_of_eastward_wind' 'm s-2'
+ 403  'tendency_of_eastward_wind_due_to_convection' 'm s-2'
+ 404  'tendency_of_eastward_wind_due_to_gravity_wave_drag' 'm s-2'
+ 405  'tendency_of_northward_wind' 'm s-2'
+ 406  'tendency_of_northward_wind_due_to_convection' 'm s-2'
+ 407  'tendency_of_northward_wind_due_to_gravity_wave_drag' 'm s-2'
+ 408  'tendency_of_ocean_barotropic_streamfunction' 'm3 s-2'
+ 409  'tendency_of_sea_ice_thickness_due_to_thermodynamics' 'm s-1'
+ 410  'tendency_of_specific_humidity_due_to_convection' 's-1'
+ 411  'tendency_of_specific_humidity_due_to_model_physics' 's-1'
+ 412  'tendency_of_surface_air_pressure' 'Pa s-1'
+ 413  'tendency_of_wind_speed_due_to_convection' 'm s-2'
+ 414  'tendency_of_wind_speed_due_to_gravity_wave_drag' 'm s-2'
+ 415  'thunderstorm_probability' '1'
+ 416  'time' 's'
+ 417  'toa_incoming_shortwave_flux' 'W m-2'
+ 418  'toa_net_downward_radiative_flux' 'W m-2'
+ 419  'toa_net_downward_shortwave_flux' 'W m-2'
+ 420  'toa_net_upward_longwave_flux' 'W m-2'
+ 421  'toa_net_upward_longwave_flux_assuming_clear_sky' 'W m-2'
+ 422  'toa_net_upward_shortwave_flux' 'W m-2'
+ 423  'toa_outgoing_longwave_flux' 'W m-2'
+ 424  'toa_outgoing_longwave_flux_assuming_clear_sky' 'W m-2'
+ 425  'toa_outgoing_shortwave_flux' 'W m-2'
+ 426  'toa_outgoing_shortwave_flux_assuming_clear_sky' 'W m-2'
+ 427  'transpiration_amount' 'kg m-2'
+ 428  'transpiration_flux' 'kg m-2 s-1'
+ 429  'tropopause_air_pressure' 'Pa'
+ 430  'tropopause_air_temperature' 'K'
+ 431  'tropopause_altitude' 'm'
+ 432  'tropopause_downwelling_longwave_flux' 'W m-2'
+ 433  'tropopause_net_downward_longwave_flux' 'W m-2'
+ 434  'tropopause_net_downward_shortwave_flux' 'W m-2'
+ 435  'tropopause_upwelling_shortwave_flux' 'W m-2'
+ 436  'upward_air_velocity' 'm s-1'
+ 437  'upward_air_velocity_expressed_as_tendency_of_sigma' 's-1'
+ 438  'upward_eastward_stress_at_sea_ice_base' 'Pa'
+ 439  'upward_heat_flux_in_air' 'W m-2'
+ 440  'upward_northward_stress_at_sea_ice_base' 'Pa'
+ 441  'upward_sea_ice_basal_heat_flux' 'W m-2'
+ 442  'upward_sea_water_velocity' 'm s-1'
+ 443  'upward_water_vapor_flux_in_air' 'kg m-2 s-1'
+ 444  'upwelling_spectral_radiative_flux_in_air' 'W m-2 m-1'
+ 445  'upwelling_spectral_radiative_flux_in_sea_water' 'W m-2 m-1'
+ 446  'vegetation_area_fraction' '1'
+ 447  'vegetation_carbon_content' 'kg m-2'
+ 448  'virtual_temperature' 'K'
+ 449  'visibility_in_air' 'm'
+ 450  'water_content_of_atmosphere_layer' 'kg m-2'
+ 451  'water_evaporation_amount' 'kg m-2'
+ 452  'water_evaporation_flux' 'kg m-2 s-1'
+ 453  'water_flux_correction' 'kg m-2 s-1'
+ 454  'water_flux_into_ocean' 'kg m-2 s-1'
+ 455  'water_flux_into_ocean_from_rivers' 'kg m-2 s-1'
+ 456  'water_vapor_content_of_atmosphere_layer' 'kg m-2'
+ 457  'water_vapor_pressure' 'Pa'
+ 458  'water_vapor_saturation_deficit' 'Pa'
+ 459  'wet_bulb_temperature' 'K'
+ 460  'wind_from_direction' 'degree'
+ 461  'wind_mixing_energy_flux_into_ocean' 'W m-2'
+ 462  'wind_speed' 'm s-1'
+ 463  'wind_speed_shear' 's-1'
+ 464  'wind_to_direction' 'degree'
+ 465  'wind_wave_period' 's'
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple	(revision 4775)
@@ -0,0 +1,34 @@
+# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################
+ $NFIELDS 
+1
+ $END
+############################################
+ $NBMODEL 
+2 model1 model2 200 200
+ $END
+############################################
+ $RUNTIME 
+21600
+ $END
+############################################
+ $NLOGPRT 
+1 0
+ $END
+############################################
+ $STRINGS 
+FSENDANA FRECVANA 1 7200 3 rst.nc EXPOUT
+182 149 96 72 torc lmdz
+P 2 P 0 
+CHECKIN MAPPING CHECKOUT 
+INT=1
+myfile_torc_to_lmdz_CONSERV_FRACNNEI.nc src bfb 
+INT=1
+####
+ $END
+############################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz.xml	(revision 4775)
@@ -0,0 +1,282 @@
+<?xml version="1.0" encoding="UTF-8"?>
+    <dataset>
+        <oasis3-mct value="">
+            <param value="">
+                <intro value="" />
+                <generaldesc value="" />
+                <guidesc value="" />
+            </param>
+            <grids value="">
+                <modelgrids value="" />
+                <defgrids value="">
+                    <gridsline value="">
+                        <item_1389830 value="torc">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="2" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="182" />
+                                    <nj_grid value="149" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1389830>
+                        <item_1508732 value="lmdz">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="0" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="96" />
+                                    <nj_grid value="72" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1508732>
+                    </gridsline>
+                    <grid_names_list value="torc;lmdz" />
+                </defgrids>
+            </grids>
+            <modeldef value="">
+                <mainmodelparam value="" />
+                <modelparam value="">
+                    <models value="">
+                        <item_1368819 value="model1">
+                            <maxunits value="units_on">
+                                <units_on value="">
+                                    <nunit value="200" />
+                                </units_on>
+                            </maxunits>
+                        </item_1368819>
+                        <item_1379378 value="model2">
+                            <maxunits value="units_on">
+                                <units_on value="">
+                                    <nunit value="200" />
+                                </units_on>
+                            </maxunits>
+                        </item_1379378>
+                    </models>
+                    <model_names_list value="model1;model2" />
+                </modelparam>
+            </modeldef>
+            <fielddef value="">
+                <flddesc value="" />
+                <fldname value="">
+                    <flddef value="">
+                        <item_2020415 value="FS-ANA">
+                            <fldnamebef value="FSENDANA" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="FRECVANA" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="single" />
+                            <namefldgui value="FS-ANA" />
+                        </item_2020415>
+                    </flddef>
+                    <field_names_list value="FS-ANA" />
+                </fldname>
+            </fielddef>
+            <cplrststatus value="">
+                <fldproper value="" />
+                <cplrststatus value="">
+                    <crs value="">
+                        <item_2276733 value="FS-ANA">
+                            <cpl value="7200" />
+                            <restart value="rst.nc" />
+                            <status value="expout" />
+                        </item_2276733>
+                    </crs>
+                </cplrststatus>
+            </cplrststatus>
+            <seqlag value="">
+                <defineseqlag value="" />
+                <defseqlag value="">
+                    <seqlag value="">
+                        <item_2280157 value="FS-ANA">
+                            <lag value="lag_off">
+                                <lag_off value="" />
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_2280157>
+                    </seqlag>
+                </defseqlag>
+            </seqlag>
+            <timetransfo value="">
+                <timetransfo value="" />
+                <transftime value="">
+                    <time value="">
+                        <item_2287573 value="FS-ANA">
+                            <loctrans value="loctrans_off">
+                                <loctrans_off value="" />
+                            </loctrans>
+                        </item_2287573>
+                    </time>
+                </transftime>
+            </timetransfo>
+            <checktransfo value="">
+                <cicotransfo value="" />
+                <transfcico value="">
+                    <checkinoutminmax value="">
+                        <item_2292081 value="FS-ANA">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_2292081>
+                    </checkinoutminmax>
+                </transfcico>
+            </checktransfo>
+            <blastransfo value="">
+                <transfblas value="" />
+                <transfblon value="">
+                    <multaddoldnew value="">
+                        <item_2297574 value="FS-ANA">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_2297574>
+                    </multaddoldnew>
+                </transfblon>
+            </blastransfo>
+            <printruns value="">
+                <descprint value="" />
+                <runtime value="">
+                    <duration value="21600" />
+                </runtime>
+                <debug value="">
+                    <nlogprt value="ptr_1">
+                        <ptr_1 value="" />
+                    </nlogprt>
+                </debug>
+                <timestat value="">
+                    <opttime value="none">
+                        <none value="" />
+                    </opttime>
+                </timestat>
+                <generalgroup value="">
+                    <groups_onoff value="0" />
+                    <mult_fields_name value="single" />
+                </generalgroup>
+            </printruns>
+            <interpolation value="">
+                <scriptransfo value="" />
+                <transfinterp value="">
+                    <interp value="">
+                        <item_2306181 value="FS-ANA">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_2306181>
+                    </interp>
+                </transfinterp>
+            </interpolation>
+            <mapping value="">
+                <mappingtransfo value="" />
+                <transfmap value="">
+                    <map value="">
+                        <item_2337259 value="FS-ANA">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="myfile_torc_to_lmdz_CONSERV_FRACNNEI.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_2337259>
+                    </map>
+                </transfmap>
+            </mapping>
+            <conservtransof value="">
+                <conservtransfo value="" />
+                <transfconserv value="">
+                    <conservation value="">
+                        <item_2343507 value="FS-ANA">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_2343507>
+                    </conservation>
+                </transfconserv>
+            </conservtransof>
+            <summary value="">
+                <scriptsummary value="">
+                    <summaryscript value="******************************************************************
+*** Summary of the coupling fields and their transformations: 
+******************************************************************
+******************************************************************
+FSENDANA-FRECVANA:
+Source grid : torc
+Dimensions : 182x149
+Target grid : lmdz
+Dimensions : 96x72
+Source grid periodical with  2 overlapping points
+Target grid periodical with  0 overlapping points 
+Coupling period=7200
+Restart file: rst.nc
+Field status: EXPOUT
+
+Min and max of the field sent calculated
+Min and max of the received field calculated
+MAPPING is used with options: src and bfb
+********************************************************
+********************************************************" />
+                </scriptsummary>
+            </summary>
+            <write value="">
+                <scriptnamcouple value="">
+                    <namcouplescript value="$NFIELDS 
+1
+$END 
+####
+$NBMODEL 
+2 model1 model2 200 200
+$END 
+####
+$RUNTIME 
+21600
+$END 
+####
+$NLOGPRT 
+1 0
+$END 
+####
+$STRINGS 
+FSENDANA FRECVANA 1 7200 3 rst.nc EXPOUT
+182 149 96 72 torc lmdz
+P 2 P 0 
+CHECKIN MAPPING CHECKOUT 
+INT=1
+myfile_torc_to_lmdz_CONSERV_FRACNNEI.nc src bfb 
+INT=1
+####
+ $END" />
+                </scriptnamcouple>
+            </write>
+        </oasis3-mct>
+        <meta>
+            <solver>
+                <name value="oasis3-mct" />
+            </solver>
+            <project>
+                <name value="namcouple_map_conserv_torc_lmdz" />
+                <address value="/space/coquart/oasis3-mct_buildbot/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz.xml" />
+                <username value="myName" />
+                <company value="myCompany" />
+            </project>
+            <action>
+                <callingAddress value="root.oasis3-mct.write" />
+            </action>
+            <temporary />
+            <scriptSuccess value="1" />
+            <engine>
+                <name value="OpenTEA" />
+                <launchCommand value="/usr/bin/wish /space/coquart/oasis3-mct_buildbot/util/oasisgui/opentea/opentea.tcl  -config /space/coquart/oasis3-mct_buildbot/util/oasisgui/myconfig.xml -config /space/coquart/oasis3-mct_buildbot/util/oasisgui/myconfig.xml -library /space/coquart/oasis3-mct_buildbot/util/oasisgui/library -config /space/coquart/oasis3-mct_buildbot/util/oasisgui/myconfig.xml -plugins /space/coquart/oasis3-mct_buildbot/util/oasisgui/library/DATA/pluginscripts" />
+                <pluginsPath value="/space/coquart/oasis3-mct_buildbot/util/oasisgui/library/DATA/pluginscripts" />
+                <libraryPath value="/space/coquart/oasis3-mct_buildbot/util/oasisgui/library" />
+                <configPath value="/space/coquart/oasis3-mct_buildbot/util/oasisgui/myconfig.xml" />
+            </engine>
+        </meta>
+    </dataset>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz/namcouple
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz/namcouple	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/namcouple_map_conserv_torc_lmdz/namcouple	(revision 4775)
@@ -0,0 +1,34 @@
+# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################
+ $NFIELDS 
+1
+ $END
+############################################
+ $NBMODEL 
+2 model1 model2 200 200
+ $END
+############################################
+ $RUNTIME 
+21600
+ $END
+############################################
+ $NLOGPRT 
+1 0
+ $END
+############################################
+ $STRINGS 
+FSENDANA FRECVANA 1 7200 3 rst.nc EXPOUT
+182 149 96 72 torc lmdz
+P 2 P 0 
+CHECKIN MAPPING CHECKOUT 
+INT=1
+myfile_torc_to_lmdz_CONSERV_FRACNNEI.nc src bfb 
+INT=1
+####
+ $END
+############################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/name_grids.dat
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/name_grids.dat	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/name_grids.dat	(revision 4775)
@@ -0,0 +1,6 @@
+$grid_source_characteristics
+cl_grd_src='torc'
+$end
+$grid_target_characteristics
+cl_grd_tgt='lmdz'
+$end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_atm.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_atm.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_atm.jnl	(revision 4775)
@@ -0,0 +1,3 @@
+use fdatm.nc
+shade FSENDATM
+frame/file=restart_atm.gif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_ocn.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_ocn.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/plot_restart_ocn.jnl	(revision 4775)
@@ -0,0 +1,3 @@
+use fdocn.nc
+shade FSENDOCN
+frame/file=restart_ocn.gif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FRECVANA.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FRECVANA.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FRECVANA.jnl	(revision 4775)
@@ -0,0 +1,6 @@
+use FRECVANA_model2_01.nc
+
+
+shade FRECVANA[k=1,d=1]
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FSENDANA.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FSENDANA.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_FSENDANA.jnl	(revision 4775)
@@ -0,0 +1,7 @@
+use FSENDANA_model1_01.nc
+
+
+shade FSENDANA[k=1,d=1]
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_error.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_error.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/data_oasis3/script_ferret_error.jnl	(revision 4775)
@@ -0,0 +1,7 @@
+use error.nc
+
+
+shade error[k=1,d=1]
+shade/lev=(0,1,0.01) error
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/decomp_def.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/decomp_def.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/decomp_def.F90	(revision 4775)
@@ -0,0 +1,53 @@
+!****************************************************************************************
+SUBROUTINE decomp_def(id_part_id,id_paral,id_size,id_im,id_jm,id_rank,id_npes,id_unit)
+  !
+  IMPLICIT NONE
+  INTEGER, INTENT(out) :: id_part_id    ! Local partition ID
+  INTEGER, DIMENSION(id_size), INTENT(out) :: id_paral(id_size)    
+  INTEGER, INTENT(in)  :: id_size
+  INTEGER, INTENT(in)  :: id_im       ! Grid dimension in i
+  INTEGER, INTENT(in)  :: id_jm       ! Grid dimension in j
+  INTEGER, INTENT(in)  :: id_rank     ! Rank of process
+  INTEGER, INTENT(in)  :: id_npes     ! Number of processes involved in the coupling
+  INTEGER, INTENT(in)  :: id_unit     ! Unit of log file
+  INTEGER              :: il_imjm, il_partj
+  !
+  il_imjm = id_im*id_jm
+  il_partj = id_jm/id_npes  ! Nbr of latitude circles in the partition
+  !
+#ifdef DECOMP_APPLE
+  ! Each process is responsible for a part of field defined by
+  ! the number of grid points and the offset of the first point
+  !
+  WRITE (id_unit,*) 'APPLE partitioning'
+  !
+  IF (id_rank .LT. (id_npes-1)) THEN
+      id_paral (1) = 1
+      id_paral (2) = id_rank*(il_partj * id_im)
+      id_paral (3) = il_partj * id_im
+  ELSE
+      id_paral (1) = 1
+      id_paral (2) = id_rank*(il_partj * id_im)
+      id_paral (3) = il_imjm-(id_rank*(il_partj * id_im))
+  ENDIF
+  !
+#elif defined DECOMP_BOX
+  !
+  WRITE (id_unit,*) 'BOX partitioning'
+  !
+  ! Each process is responsible for a rectangular box of 32x48 points
+  !
+  id_paral (1) = 2
+  id_paral (5) = id_im
+  id_paral (2) = id_rank*il_partj*id_im
+  id_paral (3) = id_im
+  IF (id_rank .LT. (id_npes-1)) THEN
+      id_paral (4) = il_partj
+  ELSE
+      id_paral (4) = id_jm-(id_rank*il_partj)
+  ENDIF
+  !
+#endif
+  !
+END SUBROUTINE decomp_def
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/function_ana.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/function_ana.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/function_ana.F90	(revision 4775)
@@ -0,0 +1,41 @@
+SUBROUTINE function_ana(ni,nj, &
+                        coords_1,coords_2, &
+                        fnc_ana,ib)
+  !*********************************************************************************************************************
+  !
+  IMPLICIT NONE
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  ! Constants
+  !
+  REAL (kind=wp), PARAMETER    :: coef = 2.
+  !
+  REAL (kind=wp), PARAMETER    :: dp_pi=3.14159265359
+  REAL (kind=wp), PARAMETER    :: dp_length= 1.2*dp_pi
+  REAL (kind=wp), PARAMETER    :: dp_conv = dp_pi/180.
+  !
+  INTEGER, INTENT(in) :: ni,nj,ib
+  !
+  INTEGER             :: i,j
+  !
+  REAL (kind=wp), INTENT(out)            :: fnc_ana(ni,nj)
+  !
+  REAL (kind=wp)                         :: coords_1(ni,nj)
+  REAL (kind=wp)                         :: coords_2(ni,nj)
+  !
+  !
+  DO j=1,nj
+    DO i=1,ni
+      fnc_ana(i,j) =  ib*(coef - COS(dp_pi*(ACOS(COS(coords_2(i,j)* dp_conv)* &
+         COS(coords_1(i,j)* dp_conv))/dp_length)))
+    ENDDO
+  ENDDO
+  !
+  !
+END SUBROUTINE function_ana
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_Makefile	(revision 4775)
@@ -0,0 +1,2 @@
+O3DIR = ../..
+include $(O3DIR)/util/make_dir/make.inc
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_precision
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_precision	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/header_precision	(revision 4775)
@@ -0,0 +1,2 @@
+# Management of the precision of the example
+CPPKEYDP=USE_DOUBLE_PRECISION
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model1.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model1.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model1.F90	(revision 4775)
@@ -0,0 +1,337 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+!
+PROGRAM model1
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  ! Use module to read the data
+  USE read_all_data
+  !
+  ! Use module to write the data
+  USE write_all_fields
+  !
+  IMPLICIT NONE
+  !
+  INCLUDE 'mpif.h'
+  !
+  ! By default OASIS3-MCT exchanges data in double precision,
+  ! but conversion to or from single precision data is supported in the interface
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER   :: data_gridname='grids.nc' ! file with the grids
+  CHARACTER(len=30), PARAMETER   :: data_maskname='masks.nc' ! file with the masks
+  CHARACTER(len=30)              :: data_filename, field_name
+  !
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model1'
+  CHARACTER(len=128) :: comp_out ! name of the output log file 
+  CHARACTER(len=3)   :: chout
+  CHARACTER(len=4)   :: cl_grd_src ! name of the source grid
+  CHARACTER(len=4)   :: cl_grd_tgt ! name of the target grid
+  NAMELIST /grid_source_characteristics/cl_grd_src
+  NAMELIST /grid_target_characteristics/cl_grd_tgt
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat, ntot    ! dimensions in the 2 directions of space + total size
+  INTEGER :: il_size
+  INTEGER :: nc             ! number of corners
+  REAL (kind=wp), DIMENSION(:,:), POINTER    :: gg_lon,gg_lat ! lon, lat of the points
+  INTEGER, DIMENSION(:,:), POINTER           :: gg_mask ! mask, 0 == valid point, 1 == masked point 
+  !
+  INTEGER :: mype, npes ! rank and  number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  INTEGER :: FILE_Debug=2
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER      :: var_name = 'FSENDANA' ! 8 characters field sent by model1 to model2
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                       :: var_id
+  INTEGER                       :: var_nodims(2) 
+  INTEGER                       :: var_type
+  !
+  REAL (kind=wp), PARAMETER     :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 1 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 3600     ! time step
+  !
+  INTEGER                       :: il_flag  ! Flag for grid writing by proc 0
+  !
+  INTEGER                       :: itap_sec ! Time used in oasis_put/get
+  !
+  ! Grid parameters definition
+  INTEGER                       :: part_id  ! use to connect the partition to the variables
+                                            ! in oasis_def_var
+  INTEGER                       :: var_sh(4) ! local dimensions of the arrays to the pe
+                                             ! 2 x field rank (= 4 because fields are of rank = 2)
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp),   POINTER     :: field_send(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'oasis_init_comp abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 100')
+  ENDIF
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 107')
+  ENDIF
+  !
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_get_localcomm ( localComm, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'oasis_get_localcomm abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 116')
+  ENDIF
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_comm_size abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 123')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 129')
+  ENDIF
+  !
+  IF ((FILE_Debug == 1) .AND. (mype == 0)) FILE_Debug=2
+  !
+  IF (FILE_Debug <= 1) THEN
+      IF (mype == 0) THEN
+          w_unit = 100 + rank
+          WRITE(chout,'(I3)') w_unit
+          comp_out=comp_name//'.root_'//chout
+          OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+      ELSE
+          w_unit = 15
+          comp_out=comp_name//'.notroot'
+          OPEN(w_unit,file=TRIM(comp_out),form='formatted',position='append')
+      ENDIF
+  ELSE
+      w_unit = 100 + rank
+      WRITE(chout,'(I3)') w_unit
+      comp_out=comp_name//'.out_'//chout
+      OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  ENDIF
+  !
+  IF (FILE_Debug >= 2) THEN
+      OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+      WRITE (w_unit,*) '-----------------------------------------------------------'
+      WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+      WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+      WRITE (w_unit,*) '----------------------------------------------------------'
+      WRITE(w_unit,*) 'I am the', TRIM(comp_name), ' ', 'comp', comp_id, 'local rank', mype
+      WRITE (w_unit,*) 'Number of processors :',npes
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grids.nc and masks.nc netcdf files
+  ! Get arguments giving source grid acronym and field type
+  ! 
+  OPEN(UNIT=70,FILE='name_grids.dat',FORM='FORMATTED')
+  READ(UNIT=70,NML=grid_source_characteristics)
+  READ(UNIT=70,NML=grid_target_characteristics)
+  CLOSE(70)
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Source grid name :',cl_grd_src
+      CALL flush(w_unit)
+  ENDIF
+  !
+  ! Reading dimensions of the global grid
+  CALL read_dimgrid(nlon,nlat,data_gridname,cl_grd_src,w_unit,FILE_Debug)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(gg_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating gg_lon'
+  ALLOCATE(gg_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating gg_lat'
+  ALLOCATE(gg_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Read global grid longitudes, latitudes, corners, mask 
+  CALL read_grid(nlon,nlat, data_gridname, cl_grd_src, w_unit, FILE_Debug, &
+                 gg_lon,gg_lat)
+  CALL read_mask(nlon,nlat, data_maskname, cl_grd_src, w_unit, FILE_Debug, &
+                 gg_mask)
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After grid and mask reading'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid 
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_size = 3
+#elif defined DECOMP_BOX
+  il_size = 5
+#endif
+  ALLOCATE(il_paral(il_size))
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After allocate il_paral, il_size', il_size
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL decomp_def (part_id,il_paral,il_size,nlon,nlat,mype,npes,w_unit)
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL oasis_def_partition (part_id, il_paral, ierror)
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!! !!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !  Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_sh(1) = 1
+  var_sh(2) = il_paral(3)
+  var_sh(3) = 1 
+#ifdef DECOMP_APPLE
+  var_sh(4) = 1
+#elif defined DECOMP_BOX
+  var_sh(4) = il_paral(4)
+#endif
+  !
+  ! Declaration of the field associated with the partition
+  CALL oasis_def_var (var_id,var_name, part_id, &
+     var_nodims, OASIS_Out, var_sh, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 256')
+  ENDIF
+  !
+  DEALLOCATE(il_paral)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_enddef ( ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_enddef abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 272')
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model1
+  !
+  ALLOCATE(field_send(var_sh(2), var_sh(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_send'
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!! 
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange in time loop 
+  ! 
+  ib = 1
+  itap_sec = delta_t * (ib-1) ! Time
+  !
+  CALL function_ana(var_sh(2), &
+                    var_sh(4), &
+                    RESHAPE(gg_lon(indi_beg:indi_end,indj_beg:indj_end),(/ var_sh(2), var_sh(4) /)), &
+                    RESHAPE(gg_lat(indi_beg:indi_end,indj_beg:indj_end),(/ var_sh(2), var_sh(4) /)), &
+                    field_send,ib)
+  !
+  ! Send FSENDANA
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'tcx sendf ',itap_sec,MINVAL(field_send),MAXVAL(field_send)
+  ENDIF
+  CALL oasis_put(var_id,itap_sec, field_send, ierror)
+  IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Sent) THEN
+      WRITE (w_unit,*) 'oasis_put abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 313')
+  ENDIF
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  IF (FILE_Debug >= 2) THEN
+      WRITE (w_unit,*) 'End of the program, before oasis_terminate'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  CALL oasis_terminate (ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_terminate abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 332')
+  ENDIF
+  !
+  !
+END PROGRAM MODEL1
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model2.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model2.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/model2.F90	(revision 4775)
@@ -0,0 +1,483 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+PROGRAM model2
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  ! Use module to read the data
+  USE read_all_data
+  !
+  ! Use module to write the data
+  USE write_all_fields
+  !
+  IMPLICIT NONE
+  !
+  INCLUDE 'mpif.h'
+  !
+  ! By default OASIS3-MCT exchanges data in double precision,
+  ! but conversion to or from single precision data is supported in the interface
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER   :: data_gridname='grids.nc' ! file with the grids
+  CHARACTER(len=30), PARAMETER   :: data_maskname='masks.nc' ! file with the masks
+  CHARACTER(len=30)              :: data_filename, field_name
+  !
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model2'
+  CHARACTER(len=128) :: comp_out ! name of the output log file
+  CHARACTER(len=3)   :: chout
+  CHARACTER(len=4)   :: cl_grd_src ! name of the source grid
+  CHARACTER(len=4)   :: cl_grd_tgt ! name of the target grid
+  NAMELIST /grid_source_characteristics/cl_grd_src
+  NAMELIST /grid_target_characteristics/cl_grd_tgt
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat, ntot    ! dimensions in the 2 directions of space + total size
+  INTEGER :: il_size
+  INTEGER :: nc             ! number of corners in the (i,j) plan
+  !
+  REAL (kind=wp), DIMENSION(:,:), POINTER    :: gg_lon,gg_lat
+  INTEGER, DIMENSION(:,:), POINTER           :: gg_mask ! mask, 0 == valid point, 1 == masked point 
+  !
+  INTEGER :: mype, npes ! rank and number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j, ij, ic_msk
+  INTEGER :: FILE_Debug=1
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name = 'FRECVANA' ! 8 characters field received by the atmosphere from the ocean
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                       :: var_id 
+  INTEGER                       :: var_nodims(2) 
+  INTEGER                       :: var_type
+  !
+  REAL (kind=wp), PARAMETER     :: field_ini = -1. ! initialisation of received fields
+  INTEGER,        PARAMETER     :: err_msk = -10000
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 1 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 3600      ! time step
+  !
+  INTEGER                       :: il_flag          ! Flag for grid writing
+  !
+  INTEGER                       :: itap_sec ! Time
+  !
+  ! Grid parameter definition
+  INTEGER                       :: part_id  ! use to connect the partition to the variables
+                                            ! in oasis_def_var
+  INTEGER                       :: var_sh(4) ! local dimensions of the arrays to the pe
+                                             ! 2 x field rank (= 4 because fields are of rank = 2)
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  ! Local fields arrays used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER       :: field_recv(:,:), field_ana(:,:), error(:,:)
+  !
+  ! Global array to plot the error by proc 0 and calculate min and max
+  REAL (kind=wp), POINTER       :: global_error(:)
+  INTEGER, POINTER              :: global_shapes(:,:)
+  INTEGER, POINTER              :: displs(:),rcounts(:)
+  !
+  ! Min and Max of the error of interpolation
+  REAL (kind=wp)             :: min,max
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL mpi_init(ierror)
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'oasis_init_comp abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 109')
+  ENDIF
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 116')
+  ENDIF
+  !
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_get_localcomm ( localComm, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'oasis_get_localcomm abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 125')
+  ENDIF
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_comm_size abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 132')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 138')
+  ENDIF
+  !
+  !
+  IF ((FILE_Debug == 1) .AND. (mype == 0)) FILE_Debug=2
+  !
+  IF (FILE_Debug <= 1) THEN
+      IF (mype == 0) THEN
+          w_unit = 100 + rank
+          WRITE(chout,'(I3)') w_unit
+          comp_out=comp_name//'.root_'//chout
+          OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+      ELSE
+          w_unit = 15
+          comp_out=comp_name//'.notroot'
+          OPEN(w_unit,file=TRIM(comp_out),form='formatted',position='append')
+      ENDIF
+  ELSE
+      w_unit = 100 + rank
+      WRITE(chout,'(I3)') w_unit
+      comp_out=comp_name//'.out_'//chout
+      OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  ENDIF
+  !
+  IF (FILE_Debug >= 2) THEN
+      OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+      WRITE (w_unit,*) '-----------------------------------------------------------'
+      WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+      WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+      WRITE (w_unit,*) '----------------------------------------------------------'
+      WRITE(w_unit,*) 'I am the', TRIM(comp_name), ' ', 'comp', comp_id, 'local rank', mype
+      WRITE (w_unit,*) 'Number of porcessors :',npes
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grids.nc and masks.nc netcdf files
+  ! Get arguments giving source grid acronym and field type
+  !
+  OPEN(UNIT=70,FILE='name_grids.dat',FORM='FORMATTED')
+  READ(UNIT=70,NML=grid_source_characteristics)
+  READ(UNIT=70,NML=grid_target_characteristics)
+  CLOSE(70)
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Target grid name :',cl_grd_tgt
+      CALL flush(w_unit)
+  ENDIF
+  !
+  ! Reading dimensions of the grid
+  CALL read_dimgrid(nlon,nlat,data_gridname,cl_grd_tgt,w_unit,FILE_Debug)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(gg_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating gg_lon'
+  ALLOCATE(gg_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating gg_lat'
+  ALLOCATE(gg_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Read global grid longitudes, latitudes and mask 
+  !
+  CALL read_grid(nlon,nlat, data_gridname, cl_grd_tgt, w_unit, FILE_Debug, &
+                 gg_lon,gg_lat)
+  CALL read_mask(nlon,nlat, data_maskname, cl_grd_tgt, w_unit, FILE_Debug, &
+                 gg_mask)
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After grids writing'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_size = 3
+#elif defined DECOMP_BOX
+  il_size = 5
+#endif
+  ALLOCATE(il_paral(il_size))
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After allocate il_paral, il_size', il_size
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL decomp_def (part_id,il_paral,il_size,nlon,nlat,mype,npes,w_unit)
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL oasis_def_partition (part_id, il_paral, ierror)
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_sh(1) = 1
+  var_sh(2) = il_paral(3)
+  var_sh(3) = 1 
+#ifdef DECOMP_APPLE
+  var_sh(4) = 1
+#elif defined DECOMP_BOX
+  var_sh(4) = il_paral(4)
+#endif
+  !
+  ! Declaration of the field associated with the partition of the grid
+  CALL oasis_def_var (var_id,var_name, part_id, &
+     var_nodims, OASIS_In, var_sh, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 266')
+  ENDIF
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_enddef ( ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_enddef abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 281')
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! RECEIVE ARRAYS AND CALCULATE THE ERROR 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  ALLOCATE(field_recv(var_sh(2), var_sh(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_recv'
+  ALLOCATE(field_ana(var_sh(2), var_sh(4)),STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_ana'
+  ALLOCATE(error(var_sh(2), var_sh(4)),STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating error'
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange in time loop
+  !
+  ib=1
+  itap_sec = delta_t * (ib-1) ! Time
+  !
+  CALL function_ana(var_sh(2),&
+                    var_sh(4), &
+                    RESHAPE(gg_lon(indi_beg:indi_end,indj_beg:indj_end),(/ var_sh(2), var_sh(4) /)), &
+                    RESHAPE(gg_lat(indi_beg:indi_end,indj_beg:indj_end),(/ var_sh(2), var_sh(4) /)), &
+                    field_ana,ib)
+  !
+  ! Get the field FRECVANA
+  field_recv=field_ini
+  CALL oasis_get(var_id,itap_sec, field_recv, ierror)
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'tcx recvf1 ',itap_sec,MINVAL(field_recv),MAXVAL(field_recv)
+  ENDIF
+  IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Recvd) THEN
+      WRITE (w_unit,*) 'oasis_get abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 327')
+  ENDIF
+  !
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE (w_unit,*) 'Calculate the error of interpolation'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  error=err_msk
+  !
+  WHERE (RESHAPE(gg_mask(indi_beg:indi_end,indj_beg:indj_end),(/ var_sh(2), var_sh(4) /)) == 0)
+      error = ABS(((field_ana - field_recv)/field_recv))*100
+  END WHERE
+  !
+  !
+  !!!!!!!!!!!!!!!!!!!!!!! Write the error and the field in a NetCDF file by proc 0 !!!!!!!!!!!!!!!!!!!!
+  ! field_recv is 0 on masked points => put error = err_msk on these points
+  !
+  IF (mype == 0) THEN
+      !
+      ALLOCATE(global_error(ntot),STAT=ierror )
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating global_error'
+      ALLOCATE(global_shapes(4,npes),STAT=ierror )
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating global_shapes'
+      ALLOCATE(displs(npes),STAT=ierror )
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating displs'
+      ALLOCATE(rcounts(npes),STAT=ierror )
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating rcounts'
+      !  
+      global_error=0.
+      global_shapes=0
+      displs=0
+      rcounts=0
+      !
+  ENDIF
+  !      
+  !
+  CALL MPI_GATHER(var_sh,4,MPI_INTEGER,global_shapes,4,MPI_INTEGER,0,localComm,ierror)
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error collecting shapes'
+  IF (mype == 0) THEN
+      IF (FILE_Debug >= 2) THEN
+          WRITE (w_unit,*) 'Shapes of all the processes :',global_shapes
+          CALL FLUSH(w_unit)
+      ENDIF
+  ENDIF
+      !
+  IF (mype == 0) THEN
+      displs(1)=0
+      DO i=2,npes
+        displs(i) = displs(i-1) + global_shapes(2,i-1) * global_shapes(4,i-1)
+      ENDDO
+      DO i=1,npes
+        rcounts(i) = global_shapes(2,i) * global_shapes(4,i)
+      ENDDO
+      !
+      IF (FILE_Debug >= 2) THEN
+          WRITE(w_unit,*) 'displs :', displs
+          WRITE(w_unit,*) 'rcounts :', rcounts
+          CALL FLUSH(w_unit)
+      ENDIF
+  ENDIF
+      !
+#ifdef NO_USE_DOUBLE_PRECISION
+      CALL MPI_gatherv(error, var_sh(2)*var_sh(4),MPI_REAL,&
+                       global_error,rcounts,displs,MPI_REAL,0,localComm,ierror)
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error collecting errors'
+      !
+#elif defined USE_DOUBLE_PRECISION
+      CALL MPI_gatherv(error, var_sh(2)*var_sh(4),MPI_REAL8,&
+                       global_error,rcounts,displs,MPI_REAL8,0,localComm,ierror)
+      IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error collecting errors'
+      !
+#endif
+      !
+  IF (mype == 0) THEN
+      !
+      data_filename='error.nc'
+      field_name='error'
+      CALL write_field(nlon,nlat, &
+                       data_filename, field_name,  &
+                       w_unit, FILE_Debug, &
+                       gg_lon, gg_lat, global_error)
+  ENDIF
+  !
+  !!!!!!!!!!!!!!!!!!!! Min and Max of the error on non masked points calculated by proc 0 !!!!!!!!!!!!!!!!
+  !
+  IF (mype == 0) THEN
+      ic_msk=0
+      DO i=1,nlon
+        DO j=1,nlat
+          ij=i+(j-1)*(nlon)
+          IF ( gg_mask(i,j) == 1 ) THEN
+              global_error(ij) = -err_msk
+              ic_msk = ic_msk + 1
+          ENDIF
+        ENDDO
+      ENDDO
+      min=MINVAL(REAL(global_error))
+      IF (FILE_Debug >= 2) THEN
+          WRITE(w_unit,*) 'Min and its location in the error field : ',min
+          WRITE(w_unit,*) MINLOC(REAL(global_error))
+          CALL FLUSH(w_unit)
+      ENDIF
+      DO i=1,nlon
+        DO j=1,nlat
+          ij=i+(j-1)*(nlon)
+          IF ( gg_mask(i,j) == 1 ) THEN
+              global_error(ij) = err_msk
+          ENDIF
+        ENDDO
+      ENDDO
+      max=MAXVAL(REAL(global_error))
+      IF (FILE_Debug >= 2) THEN
+          WRITE(w_unit,*)'Max and its location in the error field : ',max
+          WRITE(w_unit,*) MAXLOC(REAL(global_error))
+          CALL FLUSH(w_unit)
+      ENDIF
+      DO i=1,nlon
+        DO j=1,nlat
+          ij=i+(j-1)*(nlon)
+          IF ( gg_mask(i,j) == 1 ) THEN
+              global_error(ij) = 0.
+          ENDIF
+        ENDDO
+      ENDDO
+      IF (FILE_Debug >= 2) THEN
+          WRITE(w_unit,*) 'Number of masked points :',ic_msk
+          WRITE(w_unit,*) 'Error mean on non masked points: ', &
+             SUM(ABS(global_error))/((ntot)-ic_msk)
+          WRITE(w_unit,*) 'End calculation of stat on the error'
+          CALL FLUSH(w_unit)
+      ENDIF
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  IF (FILE_Debug >= 2) THEN
+      WRITE (w_unit,*) 'End of the program, before oasis_terminate'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  CALL oasis_terminate (ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_terminate abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 477')
+  ENDIF
+  !
+  CALL mpi_finalize(ierror)
+  !
+END PROGRAM MODEL2
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/read_all_data.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/read_all_data.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/read_all_data.F90	(revision 4775)
@@ -0,0 +1,281 @@
+MODULE read_all_data
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  !
+  CONTAINS
+!****************************************************************************************
+SUBROUTINE read_dimgrid (nlon,nlat,data_filename,cl_grd,w_unit,FILE_Debug)
+  !**************************************************************************************
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit,FILE_Debug
+  !
+  INTEGER                  :: il_file_id,il_grid_id,il_lon_id, &
+     il_lat_id,il_indice_id, &
+     lon_dims,lat_dims,imask_dims
+  !
+  INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: lon_dims_ids,lat_dims_ids,&
+     imask_dims_ids,lon_dims_len,&
+     lat_dims_len,imask_dims_len  
+  !               
+  INTEGER, INTENT(out)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: cl_grd ! name of the source grid
+  CHARACTER(len=8)         :: cl_nam ! cl_grd+.lon,+.lat ...
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Data_filename :',data_filename
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  cl_nam=cl_grd//".lon" 
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Longitudes :',cl_nam
+      CALL FLUSH(w_unit)
+  ENDIF
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam,  il_lon_id),    __LINE__ )
+  cl_nam=cl_grd//".lat" 
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Latitudes :',cl_nam
+      CALL FLUSH(w_unit)
+  ENDIF
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam,  il_lat_id),    __LINE__ )
+
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(il_file_id, varid=il_lon_id, ndims=lon_dims, dimids=lon_dims_ids), __LINE__ )
+  !
+  ! The value lon_dims_len(i) is obtained thanks to the lon_dims_ids ID already obtained from the file
+  DO i=1,lon_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lon_dims_ids(i),len=lon_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  nlon=lon_dims_len(1)
+  nlat=lon_dims_len(2)
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(ncid=il_file_id, varid=il_lat_id, ndims=lat_dims, dimids=lat_dims_ids), __LINE__ )
+  !
+  ! The value lat_dims_len(i) is obtained thanks to the lat_dims_ids ID already obtained from the file
+  DO i=1,lat_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lat_dims_ids(i),len=lat_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  IF ( (lat_dims_len(1) .NE. lon_dims_len(1)).OR.(lat_dims_len(2) .NE. lon_dims_len(2)) ) THEN
+      WRITE(w_unit,*) 'Problem model1 in read_dimgrid'
+      WRITE(w_unit,*) 'Dimensions of the latitude are not the same as the ones of the longitude'
+      CALL flush(w_unit)
+      STOP
+  ENDIF
+  !
+  CALL hdlerr(NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Reading input file ',data_filename
+      WRITE(w_unit,*) 'Global dimensions nlon=',nlon,' nlat=',nlat
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !
+END SUBROUTINE read_dimgrid
+
+  !****************************************************************************************
+  SUBROUTINE read_grid (nlon,nlat,&
+                        data_filename, cl_grd, w_unit, FILE_Debug, &
+                        gridlon,gridlat)
+  !**************************************************************************************
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  INTEGER                  :: i,j,k,w_unit,FILE_Debug
+  !
+  INTEGER                  :: il_file_id,il_lon_id, il_lat_id                                      
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: cl_grd ! name of the source grid
+  CHARACTER(len=8)         :: cl_nam ! cl_grd+.lon,+.lat ...
+  !
+  INTEGER,  DIMENSION(2)   :: ila_dim
+  INTEGER,  DIMENSION(2)   :: ila_what
+  !
+  REAL (kind=wp), DIMENSION(nlon,nlat)  :: gridlon,gridlat
+  !
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Data_filename :',data_filename
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  cl_nam=cl_grd//".lon" 
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Longitudes :',cl_nam
+      CALL FLUSH(w_unit)
+  ENDIF
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam,  il_lon_id),    __LINE__ )
+  cl_nam=cl_grd//".lat" 
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Latitudes :',cl_nam
+      CALL FLUSH(w_unit)
+  ENDIF
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam,  il_lat_id),    __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  !
+  ! Data
+  !
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lon_id, gridlon, &
+     ila_what, ila_dim), __LINE__ )
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Global grid longitudes reading done'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lat_id, gridlat, &
+     ila_what, ila_dim), __LINE__ )
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Global grid latitudes reading done'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'End of routine read_grid'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+END SUBROUTINE read_grid
+
+  !****************************************************************************************
+  SUBROUTINE read_mask (nlon, nlat, &
+                        data_filename, cl_grd, w_unit, FILE_Debug, &
+                        indice_mask)
+  !**************************************************************************************
+  !
+  INTEGER                  :: i,j,k,w_unit,FILE_Debug
+  !
+  INTEGER                  :: il_file_id, il_indice_id
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: cl_grd ! name of the source grid
+  CHARACTER(len=8)         :: cl_nam ! cl_grd+.lon,+.lat ...
+  !
+  INTEGER,  DIMENSION(2)   :: ila_dim
+  INTEGER,  DIMENSION(2)   :: ila_what
+  !
+  INTEGER, DIMENSION(nlon,nlat)  :: indice_mask
+  !
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  cl_nam=cl_grd//".msk" 
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam,  il_indice_id),    __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  !
+  ! Data
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_indice_id, indice_mask, &
+     ila_what, ila_dim), __LINE__ )
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Global grid mask reading done'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'End of routine read_mask'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+END SUBROUTINE read_mask
+
+  !****************************************************************************************
+  SUBROUTINE read_area (nlon,nlat, &
+                        data_filename, cl_grd, w_unit, FILE_Debug, &
+                        gridsrf)
+  !****************************************************************************************
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  INTEGER                  :: i,j,k,w_unit,FILE_Debug
+  !
+  INTEGER                  :: il_file_id,  il_srf_id
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  CHARACTER(len=4)         :: cl_grd ! name of the source grid
+  CHARACTER(len=8)         :: cl_nam ! cl_grd+.lon,+.lat ...
+  !
+  INTEGER,  DIMENSION(2)   :: ila_dim
+  INTEGER,  DIMENSION(2)   :: ila_what
+  !
+  REAL (kind=wp), DIMENSION(nlon,nlat)  :: gridsrf
+  !
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  cl_nam=cl_grd//".srf" 
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, cl_nam, il_srf_id),    __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  !
+  ! Data
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_srf_id, gridsrf, &
+     ila_what, ila_dim), __LINE__ )
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Global grid mask reading done'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'End of routine read_mask'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+END SUBROUTINE read_area
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE read_all_data
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/routine_hdlerr.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/routine_hdlerr.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/routine_hdlerr.F90	(revision 4775)
@@ -0,0 +1,21 @@
+!*********************************************************************************
+SUBROUTINE hdlerr(istatus, line)
+  !*********************************************************************************
+  use netcdf
+  implicit none
+  !
+  INCLUDE 'mpif.h'
+  !
+  ! Check for error message from NetCDF call
+  !
+  integer, intent(in) :: istatus, line
+  integer             :: ierror
+  !
+  IF (istatus .NE. NF90_NOERR) THEN
+      write ( * , * ) 'NetCDF problem at line',line
+      write ( * , * ) 'Stopped '
+      call MPI_Abort ( MPI_COMM_WORLD, 1, ierror )
+  ENDIF
+  !
+  RETURN
+END SUBROUTINE hdlerr
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/run_test_interpolation
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/run_test_interpolation	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/run_test_interpolation	(revision 4775)
@@ -0,0 +1,400 @@
+#!/bin/ksh
+#set -x
+######################################################################
+#
+host=`uname -n`
+user=`whoami`
+#
+## - Define paths
+srcdir=`pwd`
+datadir=$srcdir/data_oasis3
+casename=`basename $srcdir`
+#
+## - Name of the executables
+    exe1=model1
+    exe2=model2
+#
+############### User's section #######################################
+#
+## - Define architecture and coupler 
+arch=tioman_pgi_mpich   #tioman_pgi_mpich/corail/curie(CEA)/jade/training_computer/ubuntu
+                        #crayXE6
+#
+# - Define number of processes to run each executable
+    nproc_exe1=1
+    nproc_exe2=1
+#
+## - Define rundir
+if [ ${arch} == tioman_pgi_mpich ] || [ ${arch} == training_computer ]; then
+    MPIRUN=/usr/local/pgi/linux86-64/2011/mpi/mpich/bin/mpirun
+    rundir=${HOME}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == tioman_intel_openmpi ]; then
+    MPIRUN=/usr/local_intel12/openmpi143/bin/mpirun
+    rundir=${HOME}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == corail ]; then
+rundir=/lustre/globc/${user}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == curie ]; then
+    rundir=/ccc/work/cont005/pa0490/coquartl/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == jade ]; then
+    rundir=/data/11coqu/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == neptune_gfortran ]; then
+    rundir=/scratch/globc/coquart/oasis3-mct_buildbot/examples/${casename}/work_${casename}
+elif [ ${arch} == ubuntu ]; then 
+  MPIRUN=mpirun
+  rundir=${HOME}/Devel/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == crayXE6 ]; then
+rundir=/zhome/academic/HLRS/imk/imkbreil/Programme/oasis/oasis3-mct/examples/tutorial/work_${casename}
+elif [ ${arch} == beaufix ]; then
+# The toy must be directly in the TMPDIRs the jobs can only run in the TMPDIR
+    rundir=/scratch/utmp/cglo355/oasis3-mct/examples/tutorial/work_${casename}
+elif [ ${arch} == ada ]; then
+  MPIRUN=/opt/intel/impi/4.1.0.024/intel64/bin/mpirun
+  rundir=/workgpfs/rech/ces/rces980/modBRETAGNE/oasis3-mct/examples/tutorial/work_${casename}
+fi
+#
+############### End of user's section ################################
+#
+##- Define the name of the source grid and the target grid
+config=$datadir/name_grids.dat
+x=$(cut -d ' ' -f 1 < $config) 
+echo 'x:' $x
+SRC_GRID=`echo $x | cut -b 42-45`
+TGT_GRID=`echo $x | cut -b 94-97`
+echo 'Source grid :' $SRC_GRID
+echo 'Target grid :' $TGT_GRID
+#
+echo ''
+echo '*****************************************************************'
+echo '*** '$casename' : '$run
+echo ''
+echo 'Rundir       :' $rundir
+echo 'Architecture :' $arch
+echo 'Host         : '$host
+echo 'User         : '$user
+echo ''
+echo $exe1' runs on '$nproc_exe1 'processes'
+echo $exe2' runs on '$nproc_exe2 'processes'
+echo ''
+echo ''
+######################################################################
+###
+### 1. Copy source example directory containing everything needed
+###    into rundir
+
+\rm -fr $rundir
+mkdir -p $rundir
+
+cp -f $datadir/*nc  $rundir/.
+cp -f $datadir/*.jnl $rundir/.
+cp -f $datadir/*.dat $rundir/.
+
+cp -f $srcdir/$exe1 $rundir/.
+cp -f $srcdir/$exe2 $rundir/.
+
+cp -f $datadir/namcouple $rundir/.
+#
+cd $rundir
+#
+######################################################################
+###
+### 3. Creation of configuration scripts
+
+###---------------------------------------------------------------------
+### Linux
+###---------------------------------------------------------------------
+
+if [ $arch == tioman_pgi_mpich ] || [ $arch == training_computer ]; then
+if [ $nproc_exe1 == 1 ]; then
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 0 $rundir/$exe1
+EOF
+else
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 0 $rundir/$exe1
+EOF
+
+  count=1
+  while [[ $count -lt $nproc_exe1 ]];do
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 1 $rundir/$exe1
+EOF
+   (( count += 1 ))
+  done
+fi
+
+  count=0
+  while [[ $count -lt $nproc_exe2 ]];do
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 1 $rundir/$exe2
+EOF
+   (( count += 1 ))
+  done
+
+###---------------------------------------------------------------------
+### CORAIL
+###---------------------------------------------------------------------
+elif [ $arch == corail ] ; then
+
+  cat <<EOF > $rundir/run_$casename.$arch
+# Nom du job
+#PBS -N ${casename}
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l select=1:mpiprocs=24:ncpus=24
+#PBS -l place=scatter:excl
+# adresse email a utiliser
+##PBS -M your_email
+# Mail envoye a la fin du job
+#PBS -m ae
+
+cd $rundir
+
+source /usr/local/bin/intelmpi.sh
+ulimit -s unlimited
+#
+#
+time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### BEAUFIX
+###---------------------------------------------------------------------
+elif [ $arch == beaufix ] ; then
+
+   (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/bash
+#SBATCH --time=01:00:00
+#SBATCH -p  normal32        # partition/queue
+#SBATCH --job-name=toys     # job name
+#SBATCH -N 1                # number of nodes
+#SBATCH -n $nproc                # number of procs
+#SBATCH -o job.out%j
+#SBATCH -o job.err%j
+#SBATCH --exclusive
+
+ulimit -s unlimited
+# rundir must be in the TMPDIR
+cd $rundir
+module load intel/13.1.4.183
+module load intelmpi/4.1.1.036
+module load netcdf/4.3.0 
+#
+#
+time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### NEPTUNE
+###---------------------------------------------------------------------
+elif [ $arch == neptune_gfortran ] ; then
+
+  cat <<EOF > $rundir/run_$casename.$arch
+# Nom du job
+#PBS -N tests
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l select=1:mpiprocs=16:ncpus=16
+#PBS -l place=scatter:excl
+
+cd $rundir
+
+export LD_LIBRARY_PATH=/usr/lib64:$LD_LIBRARY_PATH
+ulimit -s unlimited
+#
+#
+time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### CURIE (normal nodes)
+###---------------------------------------------------------------------
+elif [ $arch == curie ] ; then
+
+   cat <<EOF > $rundir/appl-curie.conf
+$nproc_exe1 $rundir/$exe1
+$nproc_exe2 $rundir/$exe2
+EOF
+
+      (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/bash
+#MSUB -r test_interp # Request name
+#MSUB -n $nproc # Number of tasks to use
+#MSUB -T 3600 # Elapsed time limit in seconds
+#MSUB -o $casename_%I.o # Standard output. %I is the job id
+#MSUB -e $casename_%I.e # Error output. %I is the job id
+#MSUB -A gen6028 # Project ID
+set -x
+cd $rundir
+ccc_mprun -f appl-curie.conf
+EOF
+
+###-----------------------------------------------------------------
+### JADE - CINES
+###-----------------------------------------------------------------
+elif [ $arch == jade ] ; then
+(( NNODE = (  $nproc_exe1 + $nproc_exe2 ) / 8 ))
+(( RESTE = (  $nproc_exe1 + $nproc_exe2 ) - ( $NNODE * 8 ) ))
+if [[ $RESTE -gt 0 ]]; then
+ (( NNODE = $NNODE + 1 ))
+fi
+
+echo $NNODE
+
+cat << EOF > $rundir/run_$casename.$arch
+#PBS -S /bin/bash
+#PBS -N OASIS
+#PBS -l walltime=00:10:00
+#PBS -l select=$NNODE:ncpus=8:mpiprocs=8
+#PBS -o $rundir/out
+#PBS -e $rundir/err
+#PBS -j oe
+#
+set -evx
+module load netcdf
+cd $rundir
+cat $PBS_NODEFILE
+## Lancement executable
+which mpiexec
+export MPI_GROUP_MAX=100
+time mpiexec -n $nproc_exe1 ./$exe1 : -n $nproc_exe2 ./$exe2 
+
+EOF
+
+###---------------------------------------------------------------------
+### CRAYXE6
+###---------------------------------------------------------------------
+elif [ $arch == crayXE6 ] ; then
+
+ (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+d_aus=lm_aus.log       # Ausgabe- u. Fehlerdateien
+d_err=lm_fehler.log
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/ksh
+# Nom du job
+#PBS -N ${casename}
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l mppwidth=$nproc
+#PBS -l mppnppn=1
+#PBS -l mppdepth=1
+#PBS -o $d_aus 
+#PBS -e $d_err
+#
+cd $rundir
+#
+ulimit -c unlimited
+export LIBDWD_FORCE_CONTROLWORDS=1
+export LIBDWD_BITMAP_TYPE=ASCII
+#
+#export MPICH_GNI_DYNAMIC_CONN=disabled
+export MPICH_ENV_DISPLAY=1
+export MPICH_GNI_MAX_EAGER_MSG_SIZE=64000
+export MPICH_ABORT_ON_ERROR=1
+export MALLOC_MMAP_MAX_=0
+export MALLOC_TRIM_THRESHOLD_=-1
+#
+aprun -n $nproc_exe1 ./$exe1 : -n $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### ada
+###---------------------------------------------------------------------
+elif [ $arch == ada ] ; then
+
+ (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/ksh
+# ######################
+# ##   ADA IDRIS   ##
+# ######################
+# Nom de la requete
+# @ job_name = ${casename}
+# Type de travail
+# @ job_type = parallel
+# Fichier de sortie standard
+# @ output = Script_Output_${casename}.000001
+# Fichier de sortie erreur (le meme)
+# @ error = Script_Output_${casename}.000001
+# Nombre de processus demandes
+# @ total_tasks = ${nproc}
+# @ environment = "BATCH_NUM_PROC_TOT=32"
+# Temps CPU max. par processus MPI hh:mm:ss
+# @ wall_clock_limit = 0:30:00
+# Fin de l entete
+# @ queue
+#
+# pour avoir l'echo des commandes
+set -x
+
+# on se place dans le repertoire rundir
+cd ${rundir}
+
+module load netcdf
+module load hdf5
+
+#
+export KMP_STACKSIZE=64m
+export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/smplocal/pub/NetCDF/4.1.3/lib
+
+poe -pgmmodel MPMD -cmdfile run_file
+#
+EOF
+
+fi 
+
+######################################################################
+###
+### 4. Execute the model
+
+if [ $arch == tioman_pgi_mpich ] || [ $arch == training_computer ]; then
+    echo 'Executing the model using '$MPIRUN 
+    $MPIRUN -p4pg appl-linux.conf ./$exe1 > runjob.err
+elif [ $arch == ubuntu ] || [ $arch == tioman_intel_openmpi ] ; then
+    echo 'Executing the model using '$MPIRUN 
+    $MPIRUN -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2 > runjob.err
+elif [ $arch == corail ]; then
+    echo 'Submitting the job to queue using qsub'
+    qsub -q submit $rundir/run_$casename.$arch
+    qstat | grep $user
+elif [ $arch == beaufix ]; then
+    echo 'Submitting the job to queue using sbatch'
+    sbatch $rundir/run_$casename.$arch
+    squeue -u $user
+elif [ $arch == neptune_gfortran ]; then
+    echo 'Submitting the job to queue using qsub'
+    qsub $rundir/run_$casename.$arch
+    qstat | grep $user
+elif [ $arch == curie ]; then
+    ccc_msub $rundir/run_$casename.$arch
+    ccc_mpp | grep $user
+elif [ $arch == jade ] ; then
+    qsub $rundir/run_$casename.$arch
+    qstat -awu $user
+elif [ $arch == crayXE6 ]; then
+    echo 'Submitting the job to queue using qsub'
+    chmod u+x $rundir/run_$casename.$arch
+    qsub $rundir/run_$casename.$arch
+    qstat
+elif [ $arch == ada ]; then
+    echo 'Submitting the job to queue using llsubmit'
+    llsubmit $rundir/run_$casename.$arch
+fi
+echo $casename 'is executed or submitted to queue.'
+echo 'Results are found in rundir : '$rundir 
+
+######################################################################
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/write_all_fields.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/write_all_fields.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_interpolation/write_all_fields.F90	(revision 4775)
@@ -0,0 +1,96 @@
+MODULE write_all_fields  
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  ! 
+  CONTAINS
+    !
+ !****************************************************************************************
+  SUBROUTINE write_field (nlon,nlat, &
+                          data_filename, field_name, w_unit, FILE_Debug, &
+                          gridlon, gridlat, array)
+  !**************************************************************************************
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif defined USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  !
+  INTEGER                  :: i,j,k,w_unit,FILE_Debug
+  !
+  INTEGER                  :: il_file_id, il_array_id, il_lon_id, il_lat_id 
+  INTEGER                  :: LONID, LATID
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename,field_name
+  !
+  INTEGER,  DIMENSION(2)   :: ila_dim
+  INTEGER,  DIMENSION(2)   :: ila_what
+  !
+  REAL (kind=wp), DIMENSION(nlon,nlat)  :: gridlon,gridlat
+  REAL (kind=wp), DIMENSION(nlon,nlat)  :: array
+  !
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_CREATE(data_filename, NF90_CLOBBER, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lon", nlon, LONID), __LINE__ )
+  CALL hdlerr( NF90_DEF_DIM(il_file_id, "lat", nlat, LATID), __LINE__ )
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lon", NF90_REAL, (/LONID, LATID/), il_lon_id), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "units", "degrees_east"), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "standard_name", "longitude"), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lat", NF90_REAL, (/LONID, LATID/), il_lat_id), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "units", "degrees_north"), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "standard_name", "latitude"), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, TRIM(field_name), NF90_REAL, (/LONID, LATID/), il_array_id), __LINE__ )
+#elif defined USE_DOUBLE_PRECISION
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lon", NF90_DOUBLE, (/LONID, LATID/), il_lon_id), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "units", "degrees_east"), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lon_id, "standard_name", "longitude"), __LINE__ )
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, "lat", NF90_DOUBLE, (/LONID, LATID/), il_lat_id), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "units", "degrees_north"), __LINE__ )
+  CALL hdlerr( NF90_PUT_ATT(il_file_id, il_lat_id, "standard_name", "latitude"), __LINE__ )
+  !
+  CALL hdlerr( NF90_DEF_VAR(il_file_id, TRIM(field_name), NF90_DOUBLE, (/LONID, LATID/), il_array_id), __LINE__ )
+#endif
+  !
+  CALL hdlerr( NF90_ENDDEF(il_file_id), __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  !
+  ! Data
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lon_id, gridlon, &
+     ila_what, ila_dim), __LINE__ )
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_lat_id, gridlat, &
+     ila_what, ila_dim), __LINE__ )
+  !
+  CALL hdlerr( NF90_PUT_VAR (il_file_id, il_array_id, array, &
+     ila_what, ila_dim), __LINE__ )
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Global grid mask reading done'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'End of routine write field'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+END SUBROUTINE write_field
+
+END MODULE write_all_fields
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/dot_to_line.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/dot_to_line.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/dot_to_line.sh	(revision 4775)
@@ -0,0 +1,18 @@
+#!/bin/ksh
+#
+grid_file=$1
+mask_file=$2
+srcgrid=$3
+tgtgrid=$4
+
+    ncrename -v ${srcgrid}.lon,${srcgrid}_lon ${grid_file}
+    ncrename -v ${srcgrid}.lat,${srcgrid}_lat ${grid_file}
+    ncrename -v ${srcgrid}.clo,${srcgrid}_clo ${grid_file}
+    ncrename -v ${srcgrid}.cla,${srcgrid}_cla ${grid_file}
+    ncrename -v ${srcgrid}.msk,${srcgrid}_msk ${mask_file}
+#
+    ncrename -v ${tgtgrid}.lon,${tgtgrid}_lon ${grid_file}
+    ncrename -v ${tgtgrid}.lat,${tgtgrid}_lat ${grid_file}
+    ncrename -v ${tgtgrid}.clo,${tgtgrid}_clo ${grid_file}
+    ncrename -v ${tgtgrid}.cla,${tgtgrid}_cla ${grid_file}
+    ncrename -v ${tgtgrid}.msk,${tgtgrid}_msk ${mask_file}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/line_to_dot.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/line_to_dot.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/data_esmf/line_to_dot.sh	(revision 4775)
@@ -0,0 +1,18 @@
+#!/bin/ksh
+#
+grid_file=$1
+mask_file=$2
+srcgrid=$3
+tgtgrid=$4
+
+    ncrename -v ${srcgrid}_lon,${srcgrid}.lon ${grid_file}
+    ncrename -v ${srcgrid}_lat,${srcgrid}.lat ${grid_file}
+    ncrename -v ${srcgrid}_clo,${srcgrid}.clo ${grid_file}
+    ncrename -v ${srcgrid}_cla,${srcgrid}.cla ${grid_file}
+    ncrename -v ${srcgrid}_msk,${srcgrid}.msk ${mask_file}
+#
+    ncrename -v ${tgtgrid}_lon,${tgtgrid}.lon ${grid_file}
+    ncrename -v ${tgtgrid}_lat,${tgtgrid}.lat ${grid_file}
+    ncrename -v ${tgtgrid}_clo,${tgtgrid}.clo ${grid_file}
+    ncrename -v ${tgtgrid}_cla,${tgtgrid}.cla ${grid_file}
+    ncrename -v ${tgtgrid}_msk,${tgtgrid}.msk ${mask_file}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/esmf_regridding_unstructured/ESMF_regridding.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/esmf_regridding_unstructured/ESMF_regridding.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/esmf_regridding_unstructured/ESMF_regridding.ncl	(revision 4775)
@@ -0,0 +1,3605 @@
+;----------------------------------------------------------------------
+; Many of the following functions and procedures were written by:
+;        Mohammad Abouali, maboualiedu@gmail.com
+;              May 22nd, July 30th, 2011
+;
+;        http://sites.google.com/site/maboualihome/
+;
+; Many functions were updated, fixed, or added by Mary Haley.
+; See notes below.
+;
+; A debt of gratitude is owed to the ESMF development team, and 
+; especially Robert Oehmke, for help in using the ESMF software.
+;
+; This script was added to the NCL trunk on 13 Oct 2011.
+;
+;    Important modifications:
+;       18 Dec 2013:
+;          Added some code to get ready for automatically setting
+;          SrcMask2D.
+;
+;       23 Oct 2013:
+;         Added RemovePETLog option to ESMF_regrid so user can
+;         ask to have the PET0.RegridWeightGen.Log file removed.
+;
+;       14 Aug 2013:
+;           Added TriangularMesh, so that user can input own 
+;           triangular mesh to unstruct_to_ESMF code. This
+;           is to get around the issue of csstri being slow,
+;           and potentially chewing up memory (need to verify the
+;           memory hog claim).
+;
+;       25 Oct 2012:
+;           The LargeFile option is now True by default.
+;
+;       17 Oct 2012:
+;           Attributes attached to regridded variable were
+;           cleaned up. A new "remap" attribute will be attached
+;           to the regridded variable.
+;
+;       16 Oct 2012:
+;           ESMF_regrid and ESMF_regrid_with_weights will now
+;              return float if a float is input. Double is 
+;              returned otherwise. If you still want a double 
+;              returned, set ReturnDouble to True.
+;              This was changed AFTER 6.1.0-beta.
+;
+;       31 Jul 2012:
+;           Added a check_grid_type function to check for valid
+;              grid types ("rectilinear","5deg","G64", etc) and
+;              return necessary information.
+;       29 Jul 2012:
+;            Fixed the code for copying coordinates to use the
+;            values on the weights file instead of the description
+;            file. ESMF_copy_varcoords is the new procedure.
+;            This change pretty much renders all of the 
+;            retrieve_SCRIP_xxx, retrieve_ESMF_xxx, 
+;            retrieve_dstGrid_xxx, and retrieve_srcGrid_xxx
+;            obsolete.
+;
+;            ESMF_regrid_with_weights now copies attributes and
+;            coordinates by default.
+;            (CopyVarCoords and CopyVarAtts now default True.)
+;
+;            Added new CopyVarMeta attribute, which is True by default.
+;            Setting this to False overrides CopyVarCoords and CopyVarAtts. 
+;
+;       20 Jun 2012:
+;            Fix the section that calculates the corner grid cells
+;            so that the appropriate algorithm is used depending
+;            on whether the lat values go to -90/90.
+;            
+;       6 May 2012:
+;            Clean up error statements.
+;            Renamed RemoveDstGridFile, RemoveSrcGridFile, and
+;              RemoveGridFiles to RemoveDstFile, RemoveSrcFile,
+;              and RemoveFiles.
+;            Renamed ForceOverWrite and OverWrite to 
+;              ForceOverwrite and Overwrite (lowercase 'w').
+;            Added check for duplicate options being set 
+;                 (like SrcOverwrite and Overwrite).
+;            Renamed DstGridFileName / SrcGridFileName to
+;                just DstFileName / SrcFileName.
+;
+;       2 May 2012:
+;            Changed default names of description files to
+;               source_grid_file.nc and 
+;               destination_grid_file.nc 
+;
+;       27 April 2012:
+;            Renamed CornerLat and CornerLon to GridCornerLat and
+;            GridCornerLon to make it more clear what these are.
+;
+;       31 Jul 2012:
+;           Added a check_grid_type function to check for valid
+;              grid types ("rectilinear","5deg","G64", etc) and
+;              return necessary information.
+;       29 Jul 2012:
+;            Fixed the code for copying coordinates to use the
+;            values on the weights file instead of the description
+;            file. ESMF_copy_varcoords is the new procedure.
+;            This change pretty much renders all of the 
+;            retrieve_SCRIP_xxx, retrieve_ESMF_xxx, 
+;            retrieve_dstGrid_xxx, and retrieve_srcGrid_xxx
+;            obsolete.
+;
+;            ESMF_regrid_with_weights now copies attributes and
+;            coordinates by default.
+;            (CopyVarCoords and CopyVarAtts now default True.)
+;
+;            Added new CopyVarMeta attribute, which is True by default.
+;            Setting this to False overrides CopyVarCoords and CopyVarAtts. 
+;
+;       20 Jun 2012:
+;            Fix the section that calculates the corner grid cells
+;            so that the appropriate algorithm is used depending
+;            on whether the lat values go to -90/90.
+;            
+;       6 May 2012:
+;            Clean up error statements.
+;            Renamed RemoveDstGridFile, RemoveSrcGridFile, and
+;              RemoveGridFiles to RemoveDstFile, RemoveSrcFile,
+;              and RemoveFiles.
+;            Renamed ForceOverWrite and OverWrite to 
+;              ForceOverwrite and Overwrite (lowercase 'w').
+;            Added check for duplicate options being set 
+;                 (like SrcOverwrite and Overwrite).
+;            Renamed DstGridFileName / SrcGridFileName to
+;                just DstFileName / SrcFileName.
+;
+;       2 May 2012:
+;            Changed default names of description files to
+;               source_grid_file.nc and 
+;               destination_grid_file.nc 
+;
+;       27 April 2012:
+;            Renamed CornerLat and CornerLon to GridCornerLat and
+;            GridCornerLon to make it more clear what these are.
+;
+;       26 April 2012:
+;            For "conserve" method, be sure to divide results by
+;            "frac_b". This also meant I had to modify "reshape"
+;            so I could use it to reshape *and* conform the frac_b 
+;            array to the destination grid size.
+;
+;       22 April 2012:
+;            Renamed "method" and "pole" attributes to "InterpMethod"
+;            and "Pole" for consistency with other attributes. "method"
+;            and "pole" will still work.
+;            Added RemoveGridFiles, RemoveSrcGridFile, RemoveDstGridFile
+;            to ESMF_regrid_gen_weights.
+;
+;       13 April 2012:
+;            Removed ForcedCorners attribute. The user
+;            can just set CornerLat and CornerLon.
+;
+;       08 March 2012:
+;            Renamed this script to ESMF_regridding.ncl
+;
+;       06 March 2012:
+;            Renamed ESMF_gen_weights to ESMF_regrid_gen_weights
+;            Renamed ESMF_regrid      to ESMF_regrid_with_weights
+;            Renamed ESMF_all         to ESMF_regrid
+;
+;       08 Feb 2012:
+;            Added retrieve_ESMF_lat and retrieve_ESMF_lon.
+;            Added ESMF_all
+;            Added write_grid_description_file.
+;            Removed isbothvaratt_logical_true and made isatt_logical_true
+;               behave like it.
+;            Added isatt_logical_false.
+;            Set IgnoreMappedPoints to True by default.
+;            Set pole="none" if InterpMethod="conserve" (and pole not 
+;              explicitly set by user).
+;
+;       23 Jan 2012:
+;            Removed BothRegional and BothESMF, since they might
+;            confuse users. Use Src/DstRegional and Src/DstESMF.
+;
+;       13 Jan 2012:
+;            Renamed this script to ESMFRegriddingTools.ncl
+;
+;       12 Jan 2012:
+;            Moved copy_VarAtts_Except to contributed.ncl and 
+;            renamed to copy_VarAtts_except.
+;
+;       10 Jan 2012:
+;            Overhauled latlon_to_SCRIP to accept a grid type
+;            as input, like "1x1", "0.25", "G64", etc. 
+;            Overhauled rectilinear_to_SCRIP, curvilinear_to_SCRIP
+;            latlon_to_SCRIP, and unstructured_to_ESMF to turn some
+;            of the input arguments (like a title) into "opt"
+;            attributes. Also removed "mask2d" as an input argument,
+;            and made it an "opt" attribute.
+;
+;       09 Jan 2012:
+;            Renamed cartesian_to_SCRIP to latlon_to_SCRIP
+;               Renamed some of the attributes in this function.
+;            Added PrintTimings to the xxxx_to_SCRIP, xxxx_to_ESMF,
+;            and ESMF_gen_weights functions.
+;
+;       01 Jan 2012:
+;            Changed behavior of ForceOverWrite. No longer
+;            requires OverWrite to be set. Removed
+;            ForceUnstructured since it's not really needed.
+;            Added get_start_time and print_elapsed_time.
+;
+;       22 Dec 2011:
+;            Renamed some more functions: changed "esmf" to "ESMF"
+;            and "scrip" to "SCRIP".
+;            Changed esmf_remap_weights to ESMF_gen_weights.
+;            Changed esmf_remap to ESMF_regrid
+;            Converted ESMF_gen_weights to a procedure.
+;            Other changes to clean up error statements, remove
+;               extraneous print statements, add more comments.
+;
+;       20 Dec 2011:
+;            Combined GenBox_with_LLURCorner and GenBox_with_Center_Dim
+;            into one script called "cartesian_to_SCRIP".
+;
+;       18 Dec 2011: 
+;            Cleaned up Auto2SCRIP:
+;               - changed to procedure
+;               - renamed to auto_to_SCRIP
+;               - changed values for "coordType"
+;               - cleaned up "if-else-endif" statements
+;
+;       18 Dec 2011: 
+;            Cleaned up this script to:
+;               - rename some functions and/or change to procedures
+;               - use better functions where appropriate
+;               - align code to make it easier to read
+;               - add routine names to error prints
+;
+;       15 Dec 2011: 
+;            Added the "-i" flag to the ESMF_RegridWeightGen
+;            command to properly handle regional grids like WRF. 
+;            The WRF regridding example wasn't working otherwise.
+;
+;       09 Nov 2011: 
+;            Decided to completely remove "remove outlier" code.
+;            Cleaned up the sparse_matrix_mult code to correctly
+;            handle the case of the source grid being 1D.
+;
+;       06 Nov 2011: 
+;            Made code faster by adding option
+;            ("RemoveOutliers", False by default) to not
+;            remove outliers. It turns out this code was
+;            added to fix bug in original SMM code in
+;            handling missing values. This code should no
+;            longer be needed.
+;
+;            Added PrintTimings to time the sparse matrix multiply
+;            and the removing outliers code.
+;
+;       02 Nov 2011: 
+;            Replaced the SMM call with the new sparse_matrix_mult
+;            function.
+;
+;       01 Nov 2011: 
+;            Created a built-in version of "reshape" which doesn't
+;            copy any metadata. Removed the "reshape" that was in
+;            this file.
+;
+;       31 Oct 2011: 
+;            Replaced "return(tointeger(1))" with just "return(1)"
+;            Removed SMM and squeeze, since they don't seemed to be
+;            used by anybody.
+;
+;       14 Oct 2011:
+;            Removed references to $ESMFBINDIR. This should be on 
+;            user's search path. Also, executable had wrong name,
+;            changed to "ESMF_RegridWeightGen".
+
+;======================================================================
+; This function returns the start time, either in CPU or wall
+; clock seconds, depending on your version of NCL. Use this function
+; with print_elapsed_time, below.
+;======================================================================
+undef("get_start_time")
+function get_start_time()
+local s
+begin
+  s = str_split(get_ncl_version(),".")        
+  if(s(0).eq."5".or.(s(0).eq."6".and.s(1).eq."0")) then
+    return(systemfunc("date"))
+  else
+    return(get_cpu_time())
+  end if
+end
+
+;======================================================================
+; This procedure prints the elapsed time, either in CPU or wall
+; clock seconds, depending on your version of NCL. Use this procedure
+; with get_start_time, above.
+;======================================================================
+undef("print_elapsed_time")
+procedure print_elapsed_time(stime,title)
+local s 
+begin
+  s = str_split(get_ncl_version(),".")        
+  if(s(0).eq."5".or.(s(0).eq."6".and.s(1).eq."0")) then
+    wallClockElapseTime(stime, title, 0)
+  else
+    diff_time = get_cpu_time() - stime
+    print("=====> CPU Elapsed Time: " + title + ": " + diff_time + " seconds <=====")
+  end if
+end
+
+;======================================================================
+; This function receives a set of variable names and checks 
+; if their units attribute contains north or east
+; If it contains:
+;           north, it returns "latitude"
+;           east, it returns "longitude"
+; otherwise it returns "unknown"
+;======================================================================
+undef("isLatorLon")
+function isLatorLon(fid,VarNames[*]:string)
+local NumNames, OutPut, i
+begin
+    NumNames = dimsizes(VarNames)
+    OutPut   = new(NumNames,"string","No_FillValue")
+    OutPut   = "unknown"
+    do i=0,NumNames-1
+        if (isfilevar(fid,VarNames(i)).and. \
+            isfilevaratt(fid,VarNames(i),"units")) then
+            if( isStrSubset(str_lower(fid->$VarNames(i)$@units),"north") ) then
+                OutPut(i)="latitude"
+            else if ( isStrSubset(str_lower(fid->$VarNames(i)$@units),"east") ) then
+                OutPut(i)="longitude"
+            end if
+            end if
+        end if
+    end do
+    return(OutPut)
+end
+
+;***********************************************************************;
+; Function : get_att_value(                                             ;
+;              opt[1]  : logical                                        ;
+;              attname : string                                         ;
+;              default_val                                              ;
+;                                                                       ;
+; This function checks to see if the given attribute has been set, and  ;
+; if so, it returns its value. Otherwise, it returns the default value  ;
+; which is the 3rd argument.                                            ;
+;***********************************************************************;
+undef("get_att_value")
+function get_att_value(opt,attname:string,default_val)
+local return_val
+begin
+  if(islogical(opt).and.opt.and..not.any(ismissing(getvaratts(opt))).and.\
+    isatt(opt,attname)) then
+    return_val = opt@$attname$
+  else
+    return_val = default_val
+  end if
+  return(return_val)
+end
+
+
+;======================================================================
+; This function will return True if Opt is True and the AttName 
+; attribute is a logical attribute that is set to True
+;======================================================================
+undef("isatt_logical_true")
+function isatt_logical_true(Opt[1]:logical,AttName[1]:string)
+begin
+    if (isatt(Opt,AttName).and.islogical(Opt@$AttName$)) then
+        return(Opt@$AttName$)
+    end if
+    return(False)
+end     ; of isatt_logical_true(...)
+
+;======================================================================
+; This function will return True if Opt is True and the AttName 
+; attribute is a logical attribute that is set to False
+;======================================================================
+undef("isatt_logical_false")
+function isatt_logical_false(Opt[1]:logical,AttName[1]:string)
+begin
+    if (isatt(Opt,AttName).and.islogical(Opt@$AttName$).and. \
+        .not.Opt@$AttName$) then
+        return(True)
+    end if
+    return(False)
+end     ; of isatt_logical_false(...)
+
+;======================================================================
+; This procedure checks if a file already exists, and removes if 
+; certain options are set.
+;
+; If opt=True and opt@Overwrite = True, then user will be prompted
+; whether to remove file.
+;
+; Otherwise, if opt=True and opt@ForceOverwrite = True, then file
+; will be removed with no prompting.
+;======================================================================
+undef("check_for_file")
+procedure check_for_file(fname,opt)
+local DEBUG
+begin
+    DEBUG = isatt_logical_true(opt,"Debug")
+    if (isfilepresent(fname)) then
+        if(isatt_logical_true(opt,"Overwrite")) then
+            system("rm -rfi "+fname)
+        else if (isatt_logical_true(opt,"ForceOverwrite")) then
+            system("rm -rf "+fname)
+        else
+            print("check_for_file: the file '" + fname + "' already exists.")
+            print("                Set opt@Overwrite      = True")
+            print("                 or opt@ForceOverwrite = True")
+            print("                 to override.")
+            exit
+        end if
+        end if
+    end if
+end
+
+;======================================================================
+; This procedure checks if two attributes are set, and set to 
+; different values. If so, they will be set to the given value,
+; and a warning printed.
+;======================================================================
+undef("check_both_atts")
+procedure check_both_atts(opt,att1,att2,attval)
+begin
+  if (isatt(opt,att1).and.isatt(opt,att2).and.\
+      opt@$att1$.ne.opt@$att2$) then
+    print("check_both_atts: you have set " + att1 + " and")
+    print("      " + att2 + " to different values.")
+    print("      Setting them both to " + attval + " to be safe.")
+    opt@$att1$ = attval
+    opt@$att2$ = attval
+  end if
+end
+
+;======================================================================
+; This function coerces the type of a variable to the given type.
+; It will also copy the attributes.
+;======================================================================
+undef("totypeof")
+function totypeof(inVar,outType)
+begin
+    Err="OK"
+    if (outType.eq."double") then
+        outVar=todouble(inVar)
+    else if (outType.eq."float") then
+        outVar=tofloat(inVar)
+    else if (outType.eq."integer") then
+        outVar=tointeger(inVar)
+    else if (outType.eq."int64") then
+        outVar=toint64(inVar)
+    else if (outType.eq."uint64") then
+        outVar=touint64(inVar)
+    else if (outType.eq."long") then
+        outVar=tolong(inVar)
+    else if (outType.eq."ulong") then
+        outVar=toulong(inVar)
+    else if (outType.eq."uint") then
+        outVar=touint(inVar)
+    else if (outType.eq."short") then
+        outVar=toshort(inVar)
+    else if (outType.eq."ushort") then
+        outVar=toushort(inVar)
+    else if (outType.eq."byte") then
+        outVar=tobyte(inVar)
+    else if (outType.eq."ubyte") then
+        outVar=toubyte(inVar)
+    else if (outType.eq."string") then
+        outVar=tostring(inVar)
+    else if (outType.eq."character") then
+        outVar=tocharacter(inVar)
+    else
+        print("totypeof: Error: conversion to the provided type is not supported.")
+        exit
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    end if
+    copy_VarAtts_except(inVar,outVar,"_FillValue")
+    return(outVar)
+end     ; of totypeof(...)
+
+;======================================================================
+; This procedure rotates the given lat/lon grid, given a rotation angle.
+; It operates directly on the input lat/lon.
+;======================================================================
+undef("rotate_latlon")
+procedure rotate_latlon(lat:snumeric,lon:snumeric,Rot[1]:numeric)
+local d2r, tmpPoints, latlon_dims
+begin
+    if ( any(dimsizes(lat).ne.dimsizes(lon) ) ) then
+        print("rotate_latlon: lat and lon must have the same dimensions.")
+        exit
+    end if
+    
+    latlon_dims    = dimsizes(lat)
+    d2r            = atan(1)/45.0;
+    RotateMat      = (/(/cos(Rot*d2r), -sin(Rot*d2r)/), \
+                       (/sin(Rot*d2r),  cos(Rot*d2r)/) /)
+
+    tmpPoints      = new( (/2,product(latlon_dims)/),typeof(lat) )
+    tmpPoints(0,:) = ndtooned(lat)
+    tmpPoints(1,:) = ndtooned(lon)
+    tmpPoints      = RotateMat#tmpPoints
+    lat            = onedtond(tmpPoints(1,:),latlon_dims)
+    lon            = onedtond(tmpPoints(0,:),latlon_dims)
+end
+
+;======================================================================
+; This functions calculates the mirror of p1 with respect to po.
+;======================================================================
+undef("mirrorP2P")
+function mirrorP2P(p1,po)
+local dVec
+begin
+    dVec    = p1-po
+    MirrorP = po-dVec
+    return(MirrorP)
+end     ; of mirrorP2P(...)
+
+;======================================================================
+; This functions checks the given string for a valid grid type:
+;    - "rectilinear"
+;    - "curvilinear"
+;    - "unstructred"
+;    - "1x1", "0.25x0.25", etc. 
+;    - "1deg", "0.25deg", etc.
+;    - "G64", "G128", tec.
+;
+; If a valid type is found, then it will be returned as a string:
+;  - "rectilinear" - returns "rectilinear"
+;  - "curvilinear" - returns "curvilinear"
+;  - "unstructured" - returns "unstructured"
+;
+; These grid types will return additional attributes:
+;  - "1x1", "0.25x0.25", etc - returns "deg" and nlat,nlon as attributes
+;  - "1deg", "0.25deg", etc  - returns "deg" and nlat,nlon as attributes
+;  - "G64", "G128", etc      - returns "gaussian" and the nlon number
+;
+; If a valid type is not found, then "none" is returned. 
+;======================================================================
+undef("check_grid_type")
+function check_grid_type(grid_type[1]:string)
+local str, dlat, dlon, nlon, ret
+begin
+  ret     = grid_type     ; this may change
+  bad_ret = "none"
+  if(any(grid_type.eq.(/"rectilinear","curvilinear","unstructured"/))) then
+    return(ret)
+  end if
+
+;---Check for "1x1", "2x3", "0.25x0.25" format
+  if(isStrSubset(grid_type,"x")) then
+    str = str_split(grid_type,"x")
+    if(dimsizes(str).ne.2) then
+      print("check_grid_type: invalid format for NxM type of grid.")
+      return(bad_ret)
+    end if
+    dlat = tofloat(str(0))
+    dlon = tofloat(str(1))
+    if(ismissing(dlat).or.ismissing(dlon)) then
+      print("check_grid_type: invalid format for NxM type of grid.")
+      return(bad_ret)
+    end if
+    ret      = "degree"
+    ret@dlat = dlat
+    ret@dlon = dlon
+    return(ret)
+  end if
+
+;---Check for "1deg", "0.25 deg" format
+  if(isStrSubset(grid_type,"deg")) then
+    str = str_split(grid_type,"deg")
+    if(dimsizes(str).ne.1) then
+      print("check_grid_type: invalid format for Ndeg type of grid.")
+      return(bad_ret)
+    end if
+    dlat = tofloat(str(0))
+    if(ismissing(dlat)) then
+      print("check_grid_type: invalid format for Ndeg type of grid.")
+      return(bad_ret)
+    end if
+    ret      = "degree"
+    ret@dlat = dlat
+    ret@dlon = dlat    ; same value for both
+    return(ret)
+  end if
+
+;---Check for "G64", "G 128" format
+  if(isStrSubset(grid_type,"G")) then
+    str = str_split(grid_type,"G")
+    if(dimsizes(str).ne.1) then
+      print("check_grid_type: invalid format for gaussian grid.")
+      return(bad_ret)
+    end if
+    nlon = tointeger(str(0))
+    if(ismissing(nlon)) then
+      print("check_grid_type: invalid format for gaussian grid.")
+      return(bad_ret)
+    end if
+    if((nlon%2).ne.0) then
+      print("check_grid_type: invalid number for gaussian grid.")
+      return(bad_ret)
+    end if
+    ret = "gaussian"
+    ret@nlon = nlon
+    ret@nlat = nlon/2
+    return(ret)
+  end if
+  print("check_grid_type: invalid grid type")
+  return(bad_ret)
+end 
+
+;======================================================================
+; This procedure is meant as a replacement for 
+; "calc_SCRIP_corners_noboundaries" (previously called 
+; "find_SCRIP_corners"). It takes the same arguments, but uses a 
+; different algorithm that was suggested by Bob Oehmke.
+;
+; After 6.1.0-beta, I realized that this algorithm really should only
+; be used if any of the lat points are at the boundary. At this point,
+; I  decided to rename this function from "calc_SCRIP_corners" to 
+; "calc_SCRIP_corners_boundaries", and go back to using 
+; "calc_SCRIP_corners_noboundaries" as the regular algorithm.
+;======================================================================
+undef("calc_SCRIP_corners_boundaries")
+procedure calc_SCRIP_corners_boundaries(lat2d[*][*],lon2d[*][*], \
+                                        grid_corner_lat, grid_corner_lon,\
+                                        opt)
+local DEBUG, latlon_dims, grid_corner_lat2d,  grid_corner_lon2d, \
+      nlat, nlon, nlatp1, nlonp1
+begin
+    DEBUG = isatt_logical_true(opt,"Debug")
+
+;---Check input dimension sizes.
+    if (any(dimsizes(lat2d).ne.dimsizes(lon2d))) then
+        print("calc_SCRIP_corners_boundaries: lat and lon must have the same dimensions.")
+        exit
+    end if
+
+    if (any(dimsizes(grid_corner_lat).ne.dimsizes(grid_corner_lon))) then
+        print("calc_SCRIP_corners_boundaries: lat and lon must have the same dimensions.")
+        exit
+    end if
+
+;---Get dimension sizes
+    latlon_dims     = dimsizes(lat2d)
+    cnr_latlon_dims = dimsizes(grid_corner_lat)
+    cnr_rank        = dimsizes(cnr_latlon_dims)
+    nlat            = latlon_dims(0)
+    nlon            = latlon_dims(1)
+    nlatp1          = nlat+1
+    nlonp1          = nlon+1
+
+    if(cnr_rank.ne.2.or.cnr_latlon_dims(0).ne.(nlat*nlon).or. \
+       cnr_latlon_dims(1).ne.4) then
+      print("calc_SCRIP_corners_boundaries: grid_corner_lat/grid_corner_lon must be (nlat*nlon) x 4")
+      exit
+    end if
+
+    if(DEBUG) then
+      print("calc_SCRIP_corners_boundaries")
+      print("     min/max original lat: " + min(lat2d) + "/" + max(lat2d))
+      print("     min/max original lon: " + min(lon2d) + "/" + max(lon2d))
+    end if
+
+;---Create array to hold a 2D array of lat/lon corners
+    grid_corner_lat2d = new((/nlatp1,nlonp1/),typeof(lat2d))
+    grid_corner_lon2d = new((/nlatp1,nlonp1/),typeof(lon2d))
+
+;---Calculate interior locations of corner grid
+    do i=1,nlat-1
+      do j=1,nlon-1
+        grid_corner_lat2d(i,j) = avg((/lat2d(i-1,j-1),lat2d(i,j-1),\
+                                       lat2d(i-1,j),  lat2d(i,j)/))
+        grid_corner_lon2d(i,j) = avg((/lon2d(i-1,j-1),lon2d(i,j-1),\
+                                       lon2d(i-1,j),  lon2d(i,j)/))
+      end do
+    end do
+
+;---Calculate bottom locations of corner grid
+    do j=1,nlon-1
+      grid_corner_lat2d(0,j) = avg((/lat2d(0,j),lat2d(0,j-1)/))
+      grid_corner_lon2d(0,j) = avg((/lon2d(0,j),lon2d(0,j-1)/))
+    end do
+
+;---Calculate top locations of corner grid
+    do j=1,nlon-1
+      grid_corner_lat2d(nlat,j) = avg((/lat2d(nlat-1,j), \
+                                        lat2d(nlat-1,j-1)/))
+      grid_corner_lon2d(nlat,j) = avg((/lon2d(nlat-1,j), \
+                                        lon2d(nlat-1,j-1)/))
+    end do
+
+;---Calculate left locations of corner grid
+    do i=1,nlat-1
+      grid_corner_lat2d(i,0) = avg((/lat2d(i,0),lat2d(i-1,0)/))
+      grid_corner_lon2d(i,0) = avg((/lon2d(i,0),lon2d(i-1,0)/))
+    end do
+
+;---Calculate right locations of corner grid
+    do i=1,nlat-1
+      grid_corner_lat2d(i,nlon) = avg((/lat2d(i,nlon-1), \
+                                        lat2d(i-1,nlon-1)/))
+      grid_corner_lon2d(i,nlon) = avg((/lon2d(i,nlon-1), \
+                                        lon2d(i-1,nlon-1)/))
+    end do
+
+;---Set four corners of corner grid
+    grid_corner_lat2d(0,0)       = lat2d(0,0)
+    grid_corner_lon2d(0,0)       = lon2d(0,0)
+    grid_corner_lat2d(0,nlon)    = lat2d(0,nlon-1)
+    grid_corner_lon2d(0,nlon)    = lon2d(0,nlon-1)
+    grid_corner_lat2d(nlat,nlon) = lat2d(nlat-1,nlon-1)
+    grid_corner_lon2d(nlat,nlon) = lon2d(nlat-1,nlon-1)
+    grid_corner_lat2d(nlat,0)    = lat2d(nlat-1,0)
+    grid_corner_lon2d(nlat,0)    = lon2d(nlat-1,0)
+
+    if(DEBUG) then
+      print("calc_SCRIP_corners_boundaries")
+      print("     min/max grid_corner_lat2d: " + \
+                  min(grid_corner_lat2d) + "/" + max(grid_corner_lat2d))
+      print("     min/max grid_corner_lon2d: " + \
+                  min(grid_corner_lon2d) + "/" + max(grid_corner_lon2d))
+    end if
+
+    n = 0
+    do i=0,nlat-1
+      do j=0,nlon-1
+        grid_corner_lat(n,0) = grid_corner_lat2d(i,  j)
+        grid_corner_lat(n,1) = grid_corner_lat2d(i,  j+1)
+        grid_corner_lat(n,2) = grid_corner_lat2d(i+1,j+1)
+        grid_corner_lat(n,3) = grid_corner_lat2d(i+1,j)
+        grid_corner_lon(n,0) = grid_corner_lon2d(i,  j)
+        grid_corner_lon(n,1) = grid_corner_lon2d(i,  j+1)
+        grid_corner_lon(n,2) = grid_corner_lon2d(i+1,j+1)
+        grid_corner_lon(n,3) = grid_corner_lon2d(i+1,j)
+        n=n+1
+      end do
+    end do
+
+    if(DEBUG) then
+      print("calc_SCRIP_corners_boundaries")
+      print("     min/max grid_corner_lat: " + min(grid_corner_lat) + \
+                                         "/" + max(grid_corner_lat))
+      print("     min/max grid_corner_lon: " + min(grid_corner_lon) + \
+                                         "/" + max(grid_corner_lon))
+    end if
+
+end     ; of calc_SCRIP_corners_boundaries(...)
+
+;======================================================================
+; This procedure is used within the curvilinear_to_SCRIP function.
+; It used to be called "find_SCRIP_corners".
+;
+; Given a structured grid, it looks for the four corners surrounding
+; each node. It returns the center of the cells for the corners.
+;
+; You have to be careful with this routine. It doesn't check if you
+; are at or near the edge of the globe (i.e. lat=90, or lon=-180),
+; and hence it might give you corners that fall outside -90/90 for lat
+; and/or 0/360 for lon.
+;
+; Really, if the user has a special grid, he/she should input the
+; corners via the GridCornerLat and GridCornerLon resources.
+;======================================================================
+undef("calc_SCRIP_corners_noboundaries")
+procedure calc_SCRIP_corners_noboundaries(lat2d[*][*],lon2d[*][*], \
+                             grid_corner_lat,grid_corner_lon,opt)
+local latlon_dims, nlat, nlon, Extlon2d, Extlat2d, ExtGridCenter_lat, \
+      ExtGridCenter_lon, tmp, ii, jj, DEBUG
+begin
+    DEBUG = isatt_logical_true(opt,"Debug")
+    delta = get_att_value(opt,"GridCornerDelta",0.25)
+
+    if ( any(dimsizes(lat2d).ne.dimsizes(lon2d) ) ) then
+        print("calc_SCRIP_corners_noboundaries: lat and lon must have the same dimensions.")
+        exit
+    end if
+
+    latlon_dims = dimsizes(lat2d)
+    nlat        = latlon_dims(0)
+    nlon        = latlon_dims(1)
+    nlatp1      = nlat+1
+    nlonp1      = nlon+1
+    nlatp2      = nlat+2
+    nlonp2      = nlon+2
+    if(DEBUG) then
+      print("calc_SCRIP_corners_noboundaries")
+      print("     min/max original lat: " + min(lat2d) + "/" + max(lat2d))
+      print("     min/max original lon: " + min(lon2d) + "/" + max(lon2d))
+    end if
+;
+; Extend the lat/lon grid (needed to calculate the
+; corners at the boundaries).
+;
+    Extlat2d = new( (/nlatp2, nlonp2/),typeof(lat2d))
+    Extlon2d = new( (/nlatp2, nlonp2/),typeof(lon2d))
+
+;---The middle grid is exactly the original lat2d/lon2d arrays
+    Extlat2d(1:nlat,1:nlon) = (/lat2d/)
+    Extlon2d(1:nlat,1:nlon) = (/lon2d/)
+    
+;---bottom row, minus corners
+    Extlat2d(0,1:nlon)      = mirrorP2P(lat2d(1,:),lat2d(0,:))
+    Extlon2d(0,1:nlon)      = mirrorP2P(lon2d(1,:),lon2d(0,:))
+
+;---top, minus corners
+    Extlat2d(nlatp1,1:nlon) = mirrorP2P(lat2d(nlat-2,:),lat2d(nlat-1,:))
+    Extlon2d(nlatp1,1:nlon) = mirrorP2P(lon2d(nlat-2,:),lon2d(nlat-1,:))
+
+;---left, minus corners
+    Extlat2d(1:nlat,0)      = mirrorP2P(lat2d(:,1),lat2d(:,0))
+    Extlon2d(1:nlat,0)      = mirrorP2P(lon2d(:,1),lon2d(:,0))
+
+;---right, minus corners
+    Extlat2d(1:nlat,nlonp1) = mirrorP2P(lat2d(:,nlon-2),lat2d(:,nlon-1)) 
+    Extlon2d(1:nlat,nlonp1) = mirrorP2P(lon2d(:,nlon-2),lon2d(:,nlon-1))
+
+;---lower left corner
+    Extlat2d(0,0)           = mirrorP2P(lat2d(1,1),lat2d(0,0))
+    Extlon2d(0,0)           = mirrorP2P(lon2d(1,1),lon2d(0,0))
+
+;---upper right corner
+    Extlat2d(nlatp1,nlonp1) = mirrorP2P(lat2d(nlat-2,nlon-2), \
+                                        lat2d(nlat-1,nlon-1))
+    Extlon2d(nlatp1,nlonp1) = mirrorP2P(lon2d(nlat-2,nlon-2),\
+                                        lon2d(nlat-1,nlon-1))
+;---lower right corner
+    Extlat2d(0,nlonp1)      = mirrorP2P(lat2d(1,nlon-2),lat2d(0,nlon-1))
+    Extlon2d(0,nlonp1)      = mirrorP2P(lon2d(1,nlon-2),lon2d(0,nlon-1))
+
+;---upper left corner
+    Extlat2d(nlatp1,0)      = mirrorP2P(lat2d(nlat-2,1),lat2d(nlat-1,0))
+    Extlon2d(nlatp1,0)      = mirrorP2P(lon2d(nlat-2,1),lon2d(nlat-1,0))
+    
+;
+; This kludge is commented out for now, because it's not a good one.
+; We need a better way to fix the boundary corners if they go over.
+;
+;;    if(DEBUG) then
+;;      print("calc_SCRIP_corners_noboundaries")
+;;      print("      Before kludge to fix lat/lon corners...")
+;;      print("      min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
+;;      print("      min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
+;;    end if
+;;
+;;;---Kludge to cap the latitudes at -90/90
+;;    Extlat2d = where(Extlat2d.lt. -90, -90,Extlat2d)
+;;    Extlat2d = where(Extlat2d.gt.  90,  90,Extlat2d)
+;;    Extlon2d = where(Extlon2d.lt.   0,   0,Extlon2d)
+;;    Extlon2d = where(Extlon2d.gt. 360, 360,Extlon2d)
+;;
+;;    if(DEBUG) then
+;;      print("calc_SCRIP_corners_noboundaries")
+;;      print("     After kludge to fix lat/lon corners...")
+;;      print("     min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
+;;      print("     min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
+;;    end if
+
+    if(DEBUG) then
+      print("calc_SCRIP_corners_noboundaries")
+      print("     min/max Extlat2d: " + min(Extlat2d) + "/" + max(Extlat2d))
+      print("     min/max Extlon2d: " + min(Extlon2d) + "/" + max(Extlon2d))
+    end if
+;
+; Calculate the cell center of the extended grid, which 
+; would be the corner coordinates for the original grid.
+;
+    tmp = Extlat2d(:,1:nlonp1)+Extlat2d(:,0:nlon)
+    ExtGridCenter_lat       = ndtooned((tmp(1:nlatp1,:)+tmp(0:nlat,:))*delta)
+
+    tmp = Extlon2d(:,1:nlonp1)+Extlon2d(:,0:nlon)
+    ExtGridCenter_lon       = ndtooned((tmp(1:nlatp1,:)+tmp(0:nlat,:))*delta)
+    delete(tmp)
+
+    if(DEBUG) then
+      print("calc_SCRIP_corners_noboundaries")
+      print("     min/max ExtGridCenter_lat: " + \
+                  min(ExtGridCenter_lat) + "/" + max(ExtGridCenter_lat))
+      print("     min/max ExtGridCenter_lon: " + \
+                  min(ExtGridCenter_lon) + "/" + max(ExtGridCenter_lon))
+    end if
+;---Extract the grid cell corners
+    ii = ndtooned(conform_dims((/nlat,nlon/),ispan(0,nlon-1,1),1))
+    jj = ndtooned(conform_dims((/nlat,nlon/),ispan(0,nlat-1,1),0))
+
+    grid_corner_lat(:,0) = ExtGridCenter_lat(jj*(nlonp1)+ii)
+    grid_corner_lat(:,1) = ExtGridCenter_lat(jj*(nlonp1)+(ii+1))
+    grid_corner_lat(:,2) = ExtGridCenter_lat((jj+1)*(nlonp1)+(ii+1))
+    grid_corner_lat(:,3) = ExtGridCenter_lat((jj+1)*(nlonp1)+ii)
+    
+    grid_corner_lon(:,0) = ExtGridCenter_lon(jj*(nlonp1)+ii)
+    grid_corner_lon(:,1) = ExtGridCenter_lon(jj*(nlonp1)+(ii+1))
+    grid_corner_lon(:,2) = ExtGridCenter_lon((jj+1)*(nlonp1)+(ii+1))
+    grid_corner_lon(:,3) = ExtGridCenter_lon((jj+1)*(nlonp1)+ii)
+
+end     ; of calc_SCRIP_corners_noboundaries(...)
+
+;======================================================================
+; This procedure generates an ESMF file for an unstructured grid.
+; It is sometimes better to even store logically rectangular and 
+; structured grids as unstructured grids. (Refer to TriPolar - TGrid)
+;======================================================================
+undef("unstructured_to_ESMF")
+procedure unstructured_to_ESMF(FName[1]:string,inLat,inLon,Opt[1]:logical)
+local DEBUG, lat, lon, NodeMask, ElementVertices, title
+begin
+;---Check for options
+    PrintTimings = isatt_logical_true(Opt,"PrintTimings")
+    if(PrintTimings) then
+      start_time = get_start_time()
+    end if
+
+    DEBUG = isatt_logical_true(Opt,"Debug")
+
+;---Check if the file already exists
+    check_for_file(FName,Opt)
+
+;---Do we need to create a large file?
+    if (.not.isatt_logical_false(Opt,"LargeFile")) then
+      setfileoption("nc","Format","LargeFile") 
+    end if
+
+    lat = ndtooned(inLat)
+    lon = ndtooned(inLon)
+
+    if (dimsizes(lat).ne.dimsizes(lon)) then
+        print("unstructured_to_ESMF: latitude and longitude must have the same number of elements.")
+        exit
+    end if
+;---Was a mask provided?
+    if(Opt.and.isatt(Opt,"Mask2D")) then
+      if(.not.all(product(dimsizes(Opt@Mask2D)).eq.dimsizes(lat))) then
+        print("unstructured_to_ESMF: Opt@Mask2D is not the correct dimensionality")
+        exit
+      else
+        NodeMask = ndtooned(Opt@Mask2D)
+      end if
+    else
+;---No masking
+      NodeMask = new(dimsizes(lat), "integer","No_FillValue")
+      NodeMask = 1
+    end if
+    
+    if(Opt.and.isatt(Opt,"InputFileName")) then
+      inputFName = Opt@InputFileName
+    else
+      inputFName = "none provided"
+    end if
+
+;---Was a triangular mesh provided?
+    if(Opt.and.isatt(Opt,"TriangularMesh")) then
+      dims = dimsizes(Opt@TriangularMesh)
+      if(dims(1).ne.3) then
+        print("unstructured_to_ESMF: TriangularMesh must be an n x 3 array")
+        exit
+      else
+        if(DEBUG) then
+          print("unstructured_to_ESMF: using triangular mesh provided by the user")
+        end if
+        ElementVertices = Opt@TriangularMesh
+      end if
+;---Was a quadrilateral mesh provided?
+    else if(Opt.and.isatt(Opt,"QuadrilateralMesh")) then
+      dims = dimsizes(Opt@QuadrilateralMesh)
+      if(dims(1).ne.4) then
+        print("unstructured_to_ESMF: QuadrilateralMesh must be an n x 4 array")
+        exit
+      else
+        if(DEBUG) then
+          print("unstructured_to_ESMF: using quadrilateral mesh provided by the user")
+        end if
+        ElementVertices = Opt@QuadrilateralMesh
+      end if
+    else
+;---Create a triangular mesh if no mesh provided
+      if(DEBUG) then
+        print("unstructured_to_ESMF: triangulating the data ... this can be slow")
+      end if
+      ElementVertices = csstri(lat,lon)       ; Triangulate
+    end if
+    end if
+    if(DEBUG) then
+      print("min/max ElementVertices = " + min(ElementVertices) + "/" + \
+                                           max(ElementVertices))
+    end if
+    ElementVertices_Dim = dimsizes(ElementVertices)
+
+    if(DEBUG) then
+      print("unstructured_to_ESMF: total number of elements created: "+ \
+               ElementVertices_Dim(0))
+    end if
+
+;---Create the file
+    fid = addfile(FName,"c")
+    setfileoption(fid,"DefineMode",True)
+
+;---Define the file attributes
+    FileAtt               = True
+    FileAtt@gridType      = "unstructured"
+    FileAtt@Conventions   = "ESMF"
+    FileAtt@Createdby     = "ESMF_regridding.ncl"
+    FileAtt@version       = "0.9"
+    FileAtt@inputFile     = inputFName 
+    FileAtt@timeGenerated = systemfunc("date")
+    FileAtt@date_created  = FileAtt@timeGenerated
+    fileattdef(fid,FileAtt)
+    
+;---Define the ESMF dimensions
+    nodeCount       = dimsizes(lat)
+    elementCount    = ElementVertices_Dim(0)
+    maxNodePElement = ElementVertices_Dim(1)
+    coordDim        = 2
+;                    0            1               2               3
+    FDimNames=(/ "nodeCount","elementCount","maxNodePElement","coordDim" /)
+    FDimSizes=(/  nodeCount , elementCount , maxNodePElement , coordDim  /)
+    FDimUnlim=(/    False   ,    False     ,      False      ,   False   /)
+	
+    filedimdef(fid,FDimNames,FDimSizes,FDimUnlim)    
+
+;---Define variables
+    filevardef(fid,"nodeCoords",    "double", (/ FDimNames(0), FDimNames(3) /))
+    filevardef(fid,"elementConn",   "integer",(/ FDimNames(1), FDimNames(2) /))
+    filevardef(fid,"numElementConn","byte",   (/ FDimNames(1) /))
+    filevardef(fid,"centerCoords",  "double", (/ FDimNames(1), FDimNames(3) /))
+    filevardef(fid,"elementArea",   "double", (/ FDimNames(1) /))
+    filevardef(fid,"elementMask",   "integer",(/ FDimNames(1) /))
+    
+;---Define the variables unit attribute
+    AttNodeCoords               = 0
+    AttNodeCoords@units         = "degrees"
+    
+    AttElementConn              = 0
+    AttElementConn@long_name    = "Node Indices that define the element connectivity"
+    AttElementConn@_FillValue   = -1
+    
+    AttNumElementConn           = 0
+    AttNumElementConn@long_name = "Number of nodes per element"
+    
+    AttCenterCoords             = 0
+    AttCenterCoords@units       = "degrees"
+    
+    AttElementArea              = 0
+    AttElementArea@units        = "radians^2"
+    AttElementArea@long_name    = "area weights"
+    
+    filevarattdef(fid,"nodeCoords",    AttNodeCoords)
+    filevarattdef(fid,"elementConn",   AttElementConn)
+    filevarattdef(fid,"numElementConn",AttNumElementConn)
+    filevarattdef(fid,"centerCoords",  AttCenterCoords)
+    filevarattdef(fid,"elementArea",   AttElementArea)
+    
+;---Prepare the file to store the values
+    setfileoption(fid,"DefineMode",False)
+    
+;---Store Node Coordinates
+    nodeCoords      = new((/nodeCount,coordDim/),"double","No_FillValue")
+    nodeCoords(:,0) = lon
+    nodeCoords(:,1) = lat
+    fid->nodeCoords = (/nodeCoords/)
+    
+;---Store Element Connectivity
+    fid->elementConn = (/ElementVertices+1/)
+    
+;---Store numElementConn
+    numElementConn      = new((/elementCount/),"byte","No_FillValue")
+    numElementConn      = tobyte(3)
+    fid->numElementConn = (/numElementConn/)
+
+;---Store center of each element, but first calculating the centeroids.
+    centerCoords      = new((/elementCount,coordDim/),"double","No_FillValue")
+    centerCoords(:,0) = dim_avg(reshape(lon(ndtooned(ElementVertices)), \
+                                       (/elementCount,3/)))
+    centerCoords(:,1) = dim_avg(reshape(lat(ndtooned(ElementVertices)), \
+                                        (/elementCount,3/)))
+    fid->centerCoords = (/centerCoords/)
+    
+;---Store element area
+    d2r = atan(1)/45.0;
+;;  elementArea  = new(elementCount,"double","No_FillValue")
+;; Redundant? Maybe needed to remove _FillValue?
+;;  elementalLat = new((/elementCount,3/),"double","No_FillValue")
+;;  elementalLon = new((/elementCount,3/),"double","No_FillValue")
+    elementalLat = todouble(reshape(lat(ndtooned(ElementVertices)),(/elementCount,3/)))
+    elementalLon = todouble(reshape(lon(ndtooned(ElementVertices)),(/elementCount,3/)))
+    elementArea  = todouble(gc_tarea(elementalLat,elementalLon))
+    delete(elementalLat)
+    delete(elementalLon)
+    if(DEBUG) then
+      print("unstructured_to_ESMF: Element Area: min:" + min(elementArea) + \
+                                               " max:" + max(elementArea))
+    end if
+    fid->elementArea = (/elementArea/)
+
+;---Store the element Mask
+    elementMask = dim_sum(reshape(NodeMask(ndtooned(ElementVertices)), \
+                                  (/elementCount,3/)))
+    elementMask      =  where(elementMask.eq.3,1,0)
+    fid->elementMask = (/elementMask/)
+
+    if(PrintTimings) then
+      print_elapsed_time(start_time,"unstructured_to_ESMF")
+    end if
+end     ; of unstructured_to_ESMF(...)
+;======================================================================
+; This function receives a 2D curvilinear grid and mask and stores
+; it in FName NetCDF file based on SCRIP standard.
+; lat2d and lon2d must have (nlat,nlot) dimension.
+; Opt controls the behavior of the function
+; current attribute in Opt are:
+; (1) Overwrite [Logical] if True, and if the out file already exists
+;     it will erase the file.
+; (2) ForceOverwrite [Logical] If set to True, the user is not asked
+;     for removing an existing file. If set to false the user permission
+;     is required to remove an existing file. This is ineffective if
+;     Overwrite is set to False.
+; (3) If GridCornerLat and GridCornerLon are set, then these will be used
+;     instead of calcuation the corner points for the lat/lon cells.
+;     The corner points are needed for the "conserve" method.
+;======================================================================
+undef("curvilinear_to_SCRIP")
+procedure curvilinear_to_SCRIP(FName[1]:string,lat2d[*][*]:numeric,\
+                               lon2d[*][*]:numeric,Opt[1]:logical)
+local latlon_dims, nlat, nlon, fid, FileAtt, grid_siz, grid_corners, \
+grid_rank, FDimNames, FDimSizes, FDimUnlim, DummyAtt1, DummyAtt2, \
+GridCornerLat, GridCornerLon, grid_corner_lat, grid_corner_lon, mask2d, \
+lat_type, lon_type, DEBUG
+begin
+;---Check for options
+    PrintTimings = isatt_logical_true(Opt,"PrintTimings")
+    if(PrintTimings) then
+      start_time = get_start_time()
+    end if
+
+    DEBUG = isatt_logical_true(Opt,"Debug")
+
+;---Check if the file already exists
+    check_for_file(FName,Opt)
+
+;---Do we need to create a large file?
+    if (.not.isatt_logical_false(Opt,"LargeFile")) then
+      setfileoption("nc","Format","LargeFile") 
+    end if
+
+    if ( any(dimsizes(lat2d).ne.dimsizes(lon2d)) ) then
+        print("curvilinear_to_SCRIP: latitude and longitude must have the same number of elements.")
+        exit
+    end if
+
+    latlon_dims = dimsizes(lat2d)
+    nlat        = latlon_dims(0)
+    nlon        = latlon_dims(1)
+
+    if(Opt.and.isatt(Opt,"Title")) then
+      FTitle = Opt@Title
+    else
+      FTitle = "curvilinear_to_SCRIP (" + nlat + "," + nlon + ")"
+    end if
+
+;---Was a mask provided?
+    if(Opt.and.isatt(Opt,"Mask2D")) then
+      if(.not.all(dimsizes(Opt@Mask2D).eq.latlon_dims)) then
+        print("curvilinear_to_SCRIP: Opt@Mask2D is not the correct dimensionality")
+        exit
+      else
+        mask2d = Opt@Mask2D
+      end if
+    else
+;---No masking
+      mask2d = new(latlon_dims, "integer","No_FillValue")
+      mask2d = 1
+    end if
+
+;---Create the file
+    fid = addfile(FName,"c")
+    setfileoption(fid,"DefineMode",True)
+
+;---Define the file attributes
+    FileAtt              = True
+    FileAtt@title        = FTitle
+    FileAtt@Conventions  = "SCRIP"
+    FileAtt@Createdby    = "ESMF_regridding.ncl"
+    FileAtt@date_created = systemfunc("date")
+    fileattdef(fid,FileAtt)
+    
+;---Define the SCRIP dimensions
+    grid_size    = nlat*nlon   ; This is number of data points (grid nodes)
+    grid_corners = 4	
+    grid_rank    = 2
+	
+    FDimNames = (/ "grid_size","grid_corners","grid_rank" /)
+    FDimSizes = (/ grid_size,grid_corners,grid_rank /)
+    FDimUnlim = (/ False,False,False /)
+	
+    filedimdef(fid,FDimNames,FDimSizes,FDimUnlim)
+	
+;---Define Variables
+    filevardef(fid,"grid_dims","integer","grid_rank")
+    filevardef(fid,"grid_center_lat","double","grid_size")
+    filevardef(fid,"grid_center_lon","double","grid_size")
+    filevardef(fid,"grid_imask","integer","grid_size")
+    filevardef(fid,"grid_corner_lat","double",(/ "grid_size", "grid_corners" /) )
+    filevardef(fid,"grid_corner_lon","double",(/ "grid_size", "grid_corners" /) )
+    
+;---Define the variables unit attribute
+    DummyAtt1       = 0
+    DummyAtt1@units = "degrees"
+    DummyAtt2       = 0
+    DummyAtt2@units = "unitless"
+    filevarattdef(fid,"grid_center_lat",DummyAtt1)
+    filevarattdef(fid,"grid_center_lon",DummyAtt1)
+    filevarattdef(fid,"grid_imask",DummyAtt2)
+    filevarattdef(fid,"grid_corner_lat",DummyAtt1)
+    filevarattdef(fid,"grid_corner_lon",DummyAtt1)
+    delete(DummyAtt1)
+    delete(DummyAtt2)
+    
+;---Prepare the file to store the values
+    setfileoption(fid,"DefineMode",False)
+    
+;---Storing Grid Dims
+    fid->grid_dims = (/ nlon, nlat /)   ; SCRIP is FORTRAN-based.
+                                        ; (nlat,nlon) in NCL is equivalent to
+                                        ; (nlon,nlat) in FORTRAN
+    
+;---Store Cell Center Lat/Lon
+    fid->grid_center_lat = (/ndtooned(lat2d)/)
+    fid->grid_center_lon = (/ndtooned(lon2d)/)
+	
+;---Store Cell Maskes
+    if (grid_size.ne.dimsizes(ndtooned(mask2d))) then
+        print("curvilinear_to_SCRIP: Mask array is not the appropriate size.")
+        exit
+    else
+        fid->grid_imask=(/ tointeger(ndtooned(mask2d)) /)
+    end if
+	
+;---Get the grid lat/lon corners
+    if (isatt(Opt,"GridCornerLat").and.isatt(Opt,"GridCornerLon")) then
+        if(DEBUG) then
+          print("curvilinear_to_SCRIP: using grid corners provided by user...")
+        end if
+        if(.not.any(typeof(Opt@GridCornerLat).eq.(/"float","double"/))) then
+          GridCornerLat = tofloat(Opt@GridCornerLat)
+        else
+          GridCornerLat = Opt@GridCornerLat
+        end if
+        if(.not.any(typeof(Opt@GridCornerLon).eq.(/"float","double"/))) then
+          GridCornerLon = tofloat(Opt@GridCornerLon)
+        else
+          GridCornerLon = Opt@GridCornerLon
+        end if
+        grid_corner_lat = reshape( GridCornerLat,(/ grid_size, grid_corners /))
+        grid_corner_lon = reshape( GridCornerLon,(/ grid_size, grid_corners /))
+    else
+;---Estimate the grid cell corners; it's better if the user provides them.
+        if(DEBUG) then
+          print("curvilinear_to_SCRIP: calculating grid corners...")
+        end if
+        lat_type = typeof(lat2d)
+        lon_type = typeof(lon2d)
+        if(.not.any(lat_type.eq.(/"float","double"/))) then
+          lat_type = "float"
+        end if
+        if(.not.any(lon_type.eq.(/"float","double"/))) then
+          lon_type = "float"
+        end if
+        grid_corner_lat = new( (/ grid_size, grid_corners /), lat_type)
+        grid_corner_lon = new( (/ grid_size, grid_corners /), lon_type)
+        if(any(fabs(lat2d).eq.90)) then
+          if(DEBUG) then
+            print("curvilinear_to_SCRIP: one or more lat values are at the")
+            print("       poles, so calculating grid corners using")
+            print("       calc_SCRIP_corners_boundaries...")
+          end if
+          calc_SCRIP_corners_boundaries(lat2d,lon2d,grid_corner_lat,grid_corner_lon,Opt)
+        else
+          if(DEBUG) then
+            print("curvilinear_to_SCRIP: no lat values are at the poles, so")
+            print("       calculating grid corners using")
+            print("       calc_SCRIP_corners_noboundaries...")
+          end if
+          calc_SCRIP_corners_noboundaries(lat2d,lon2d,grid_corner_lat,grid_corner_lon,Opt)
+         if(any(fabs(grid_corner_lat).gt.90)) then
+           if(DEBUG) then
+             print("curvilinear_to_SCRIP: calc_SCRIP_corners_noboundaries")
+             print("       produced out-of-range latitude values.")
+             print("       Trying calc_SCRIP_corners_boundaries...")
+           end if
+           calc_SCRIP_corners_boundaries(lat2d,lon2d,grid_corner_lat,grid_corner_lon,Opt)
+          end if
+        end if
+    end if
+   
+;---Store the cell corners
+    if (isatt(grid_corner_lat,"_FillValue")) then
+        delete(grid_corner_lat@_FillValue)
+    end if
+    if (isatt(grid_corner_lon,"_FillValue")) then
+        delete(grid_corner_lon@_FillValue)
+    end if
+    fid->grid_corner_lat = (/ todouble(grid_corner_lat) /)
+    fid->grid_corner_lon = (/ todouble(grid_corner_lon) /)
+
+    if(PrintTimings) then
+      print_elapsed_time(start_time,"curvilinear_to_SCRIP")
+    end if
+end     ; of curvilinear_to_SCRIP(...)
+
+;======================================================================
+; This function accept an array of latitudes and longitudes, creates
+; a rectilinear grid based on the given input and then stores it as a
+; SCRIP file. This procedure calls curvilinear_to_SCRIP.
+;======================================================================
+undef("rectilinear_to_SCRIP")
+procedure rectilinear_to_SCRIP(FName[1]:string,lat[*]:numeric,\
+                               lon[*]:numeric, Opt[1]:logical)
+local nlat, nlon, grid_center_lat, grid_center_lon, Opt2, FTitle
+begin
+   Opt2 = Opt
+
+;---Check for options
+    PrintTimings = isatt_logical_true(Opt2,"PrintTimings")
+    if(PrintTimings) then
+      start_time = get_start_time()
+      delete(Opt2@PrintTimings)
+    end if
+
+    if(.not.isatt(Opt2,"Title")) then
+      Opt2@Title = "rectilinear_to_SCRIP (" + dimsizes(lat) + "," + \
+                                              dimsizes(lon) + ")"
+    end if
+
+    nlat = dimsizes(lat)
+    nlon = dimsizes(lon)
+    
+;---Conform the lat/lon to 2D arrays
+    grid_center_lat = conform_dims((/nlat, nlon/),lat,0)
+    grid_center_lon = conform_dims((/nlat, nlon/),lon,1)
+
+;---Generate the mask
+    if(.not.isatt(Opt2,"Mask2D")) then
+      Opt2@Mask2D = onedtond(1,(/nlat,nlon/))
+    end if
+    
+;---Convert to SCRIP
+    curvilinear_to_SCRIP(FName,grid_center_lat,grid_center_lon,Opt2)
+
+    if(PrintTimings) then
+      print_elapsed_time(start_time,"rectilinear_to_SCRIP")
+    end if
+end     ; of rectilinear_to_SCRIP
+
+;======================================================================
+; This procedure automatically retrieves the grid information from the
+; file and converts the grid to a SCRIP file.
+;
+; The variable must have one of the following:
+;   - an attribute called "coordinates" which defines
+;      where the coordinate information are stored.
+;   - 1D coordinate arrays called "lat" and "lon"
+;   - 1D coordinate arrays with units that contain "east" and "north"
+;   - attributes with units that contain "east" and "north"
+;======================================================================
+undef("auto_to_SCRIP")
+procedure auto_to_SCRIP(srcFile[1]:string,VarName[1]:string, \
+                        SCRIPFName[1]:string,FTitle[1]:string,Opt[1]:logical)
+local i, j, fid, nDim, nlat, nlon, VarData, coordType, \
+  grid_center_lon, grid_center_lat, CoordDim, LonData, LatData, \
+  LonAttName, LatAttName, tmpAtt, LonDimName, LatDimName, tmpunits, \
+  tmpdimname, LonVarName, LatVarName, LonVarInd, LatVarInd, \
+  ResultIsLatorLon, VarNamesInCoordAtt, nCoords, CoordAtt, NumAtt, attNames, \
+  isLonFound, isLatFound
+begin
+;---Open the file if it exists
+    if (.not.isfilepresent(srcFile)) then
+        print("auto_to_SCRIP: cannot open '" + srcFile + "'.")
+        exit
+    else
+    end if
+
+    fid = addfile(srcFile,"r")
+    
+;---Check if the variable is present in the file
+    if (.not.isfilevar(fid,VarName)) then
+        print("auto_to_SCRIP: the '" + VarName + \
+              "' variable doesn't exist on the '" + srcFile + "' file.")
+        exit
+    end if
+
+    VarData = fid->$VarName$
+    
+;
+; Check if the lat/lon coordinates are defined for the variable.
+; The coordinates can be defined using one of the following methods:
+;
+; coordType = "coordinate":
+;     The variable has either:
+;      - coordinate arrays called "lat" and "lon".
+;      - coordinate arrays whose units attributes contain 
+;        "north" and "east"
+;
+; coordType = "variable":
+;     The coordinates are stored in a separate variable, with the 
+;     name of those variables defined in the "coordinates"
+;     attribute for the variable.
+;
+; coordType = "attribute"
+;     The variable has either:
+;      - attributes called "lat2d" and "lon2d"
+;      - attributes whose units attributes contain "north" and "east".
+;
+    coordType = "unknown"
+    if( all(iscoord(VarData,(/"lat","lon"/))) ) then
+        coordType  = "coordinate"
+        LonDimName = "lon"
+        LatDimName = "lat"
+    end if
+
+;---Check if the coordinate information can be found in the attributes.
+    if (coordType.eq."unknown") then
+        isLatFound = False
+        isLonFound = False        
+        attNames   = getvaratts(VarData)
+        NumAtt     = dimsizes(attNames)
+        do i=0,NumAtt-1
+;---Check if the "coordinate" attribute is set
+            if( isStrSubset(str_lower(attNames(i)),"coordinate") ) then
+                coordType = "variable"
+                CoordAtt  = VarData@$attNames(i)$
+                nCoords   = str_fields_count(CoordAtt," ")
+                if (nCoords.lt.2) then
+                    print("auto_to_SCRIP: at least two coordinates must be present")
+                    exit
+                else
+                    VarNamesInCoordAtt = new(nCoords,"string","No_FillValue")
+                    do j=0,nCoords-1
+                        VarNamesInCoordAtt(j)=str_get_field(CoordAtt,j+1," ")                        
+                    end do
+                    ResultIsLatorLon = isLatorLon(fid,VarNamesInCoordAtt)
+                    LatVarInd = ind(ResultIsLatorLon.eq."latitude")
+                    LonVarInd = ind(ResultIsLatorLon.eq."longitude")
+                    if (.not.ismissing(LatVarInd)) then
+                        isLatFound = True
+                        LatVarName = VarNamesInCoordAtt(LatVarInd)
+                    end if
+                    if (.not.ismissing(LonVarInd)) then
+                        isLonFound = True
+                        LonVarName = VarNamesInCoordAtt(LonVarInd)
+                    end if
+                    if(.not.(isLonFound.and.isLatFound)) then
+                        print("auto_to_SCRIP: cannot locate lat/lon coordinates for ")
+                        print("               variable " + VarName + \
+                              " on file " + srcFile)
+                        exit
+                    end if
+                end if
+            end if
+        end do  ; end of checking if the coordinate information can be found in the attributes.
+    end if
+        
+;---Check if there is any coordinate dimension
+    if (coordType.eq."unknown") then
+        isLatFound = False
+        isLonFound = False  
+        nDim = dimsizes(dimsizes(VarData))
+        do i=0,nDim-1
+            if(isdimnamed(VarData,i)) then
+                tmpdimname = VarData!i
+                if (iscoord(VarData,tmpdimname)) then
+                    if(isatt(VarData&$tmpdimname$,"units")) then
+                        tmpunits = VarData&$tmpdimname$@units
+                        if(isStrSubset(tmpunits,"north")) then
+                            isLatFound = True
+                            LatDimName = tmpdimname
+                        end if
+                        if(isStrSubset(tmpunits,"east")) then
+                            isLonFound = True
+                            LonDimName = tmpdimname
+                        end if
+                    end if
+                end if
+            end if
+        end do
+        if(isLonFound.and.isLatFound) then
+            coordType = "coordinate"
+        end if            
+    end if      ; end of checking if there is any coordinate dimension
+;
+; Check if there is any attributes containing the coordinates.
+; It won't work if the attributes are stored as a 1D array.
+;
+    if (coordType.eq."unknown") then
+        isLatFound = False
+        isLonFound = False  
+        do i=0,NumAtt-1
+            tmpAtt = VarData@$attNames(i)$
+            if(isatt(tmpAtt,"units")) then
+                tmpunits = tmpAtt@units
+                if(isStrSubset(tmpunits,"north")) then
+                    isLatFound = True
+                    LatAttName = attNames(i)
+                end if
+                if(isStrSubset(tmpunits,"east")) then
+                    isLonFound = True
+                    LonAttName = attNames(i)
+                end if                
+            end if
+        end do
+        if(isLonFound.and.isLatFound) then
+            coordType = "attribute"
+        end if 
+    end if      ; end of checking if there is any attributes containing the coordinates.
+    if(.not.(isLonFound.and.isLatFound)) then
+        print("auto_to_SCRIP: cannot locate lat/lon coordinates for ")
+        print("               variable " + VarName + " on file " + srcFile)
+        exit
+    end if
+
+;---Get the coordinate variable names and coordinate data
+    if (coordType.eq."variable") then
+        if(isfilevar(fid,LatVarName)) then
+            LatData = fid->$LatVarName$
+        else
+            print("auto_to_SCRIP: can't read latitude information.")
+            exit
+        end if
+        if(isfilevar(fid,LonVarName)) then
+            LonData = fid->$LonVarName$
+        else
+            print("auto_to_SCRIP: can't read longitude information.")
+            exit
+        end if
+    else if (coordType.eq."coordinate") then
+        nCoords = dimsizes(VarData)
+        LonData = VarData&$LonDimName$
+        LatData = VarData&$LatDimName$
+    else ; coordType.eq."attribute"
+        LonData = VarData@$LonAttName$
+        LatData = VarData@$LatAttName$
+        if ((dimsizes(dimsizes(LonData)).ne.2).or.\
+            (dimsizes(dimsizes(LatData)))) then
+            print("auto_to_SCRIP: " + LonAttName + " and " + \
+                                      LatAttName + " must be 2D.")
+            exit
+        end if
+    end if
+    end if  ; end of getting coordinate variables names and data
+            ; at this point lat/lon data is stored in LatData and LonData
+        
+    if (.not.all(dimsizes(LonData).eq.dimsizes(LatData))) then
+        print("auto_to_SCRIP: latitude and longitude must have the same number of dimensions.")
+        exit
+    end if
+    
+    CoordDim = dimsizes(dimsizes(LonData))
+    if ((CoordDim.eq.1).and.(coordType.eq."coordinate")) then
+        nlat = dimsizes(LatData)
+        nlon = dimsizes(LonData)
+;---Generate the grid centers
+    	grid_center_lat = conform_dims((/nlat, nlon/),LatData,0)
+        grid_center_lon = conform_dims((/nlat, nlon/),LonData,1)
+    else if ((CoordDim.eq.2).and.((coordType.eq."attribute").or. \
+                                  (coordType.eq."variable"))) then
+        grid_center_lat = LatData
+        grid_center_lon = LonData
+        delete(LatData)
+        delete(LonData)
+    else 
+        print("auto_to_SCRIP: Can't help with recognizing the coordinates.")
+        exit
+    end if
+    end if
+    
+;---Get mask
+    if (.not.isatt(Opt,"Mask2D")) then
+      Opt@Mask2D = new(dimsizes(grid_center_lat),"integer","No_FillValue")
+      Opt@Mask2D = 1
+    end if
+    Opt@Title = FTitle
+
+    curvilinear_to_SCRIP(SCRIPFName,grid_center_lat,grid_center_lon,Opt)
+end     ; of auto_to_SCRIP
+
+;======================================================================
+; This procedure generates a regularly-spaced lat/lon grid based on 
+; the corners of a lat/lon box, or a box center and the width
+; and height of the box and the spacing or the number of values.
+;
+; It was overhauled on Jan 10 2012 to allow for input of a grid type
+; rather than inputing nlat and nlon.
+;
+; GridType can be one of the following types of input:
+;
+;    "1x1", "2x3", "0.25x0.25", etc
+;    "1deg", "0.25deg" "0.25 deg" "0.25" (which means "0.25deg")
+;    "G64", "G128"
+;
+; Recognized attributes for "Opt":
+;   LLCorner  - defaults to (-90,-180)
+;   URCorner  - defaults to ( 90, 180)
+;   Rotation  - rotation angle
+;
+; It stores the grid in a NetCDF file based on SCRIP standard.
+;
+; This procedure calls curvilinear_to_SCRIP.
+;======================================================================
+undef("latlon_to_SCRIP")
+procedure latlon_to_SCRIP(FName[1]:string,GridType[1]:string,Opt[1]:logical)
+local BoxDiag, Rot, nlat, nlon, grid_type, dlat, dlon,\
+      lat, lon, gau_info, grid_center_lat, grid_center_lon, FTitle, \
+      PrintTimings, set_pt, orig_pt
+begin
+  PrintTimings = isatt_logical_true(Opt,"PrintTimings")
+  if(PrintTimings) then
+    start_time = get_start_time()
+  end if
+
+;---Check for "1x1", "2x3", "0.25x0.25" format
+  grid_type = check_grid_type(GridType)
+  if(grid_type.eq."none") then
+    print("latlon_to_SCRIP: invalid format for grid type")
+    exit
+  end if
+
+  if(grid_type.eq."degree") then
+    dlat = grid_type@dlat
+    dlon = grid_type@dlon
+  else if(grid_type.eq."gaussian") then
+    nlat = grid_type@nlat
+    nlon = grid_type@nlon
+  end if
+  end if
+
+;---Check for Opt attributes
+  if(Opt.and.isatt(Opt,"Title")) then
+    FTitle = Opt@Title
+  else
+    FTitle = GridType + " grid"
+  end if
+
+  if (Opt.and.(isatt(Opt,"Rotation"))) then
+      Rot = Opt@Rotation
+  else
+      Rot = 0.0
+  end if
+
+  if(.not.isvar("LLCorner")) then
+      if(isatt(Opt,"LLCorner")) then
+          LLCorner = Opt@LLCorner
+      else
+          LLCorner = (/-90,-180/)
+      end if
+  end if
+
+  if(.not.isvar("URCorner")) then
+      if(isatt(Opt,"URCorner")) then
+          URCorner = Opt@URCorner
+      else
+          URCorner = (/90,180/)
+      end if
+  end if
+
+;---Check the LLCorner and URCorner variables.
+  if ( (abs(LLCorner(0)).gt.90).or.(abs(URCorner(0)).gt.90) ) then
+      print("latlon_to_SCRIP: lat corners must be within -90 to 90")
+      exit
+  end if
+
+  BoxDiag = URCorner-LLCorner
+  if (Opt.and.(isatt(Opt,"Rotation"))) then
+    Rot = Opt@Rotation
+    if (Rot.ne.0.0) then
+;
+; Align the box diagonal to make box sides parallel/perpendicular
+; to equator.
+;
+      rotate_latlon(BoxDiag(0),BoxDiag(1),-1.0*Rot)
+    end if
+  else
+    Rot = 0.0
+  end if
+        
+  if ( BoxDiag(0).le.0.0 ) then
+    print("latlon_to_SCRIP: The corner latitudes do not meet the criteria of a bounding box.")
+    exit
+  end if
+  if ( BoxDiag(1).le.0.0 ) then
+    print("latlon_to_SCRIP: The corner longitudes do not meet the criteria of a bounding box.")
+    exit
+  end if
+        
+  if (Rot.ne.0.0) then
+    print("latlon_to_SCRIP: The box is rotated. Spacing may be different than what you meant.")
+  end if
+  if(grid_type.eq."degree") then
+    nlat = tointeger(BoxDiag(0)/dlat+1)
+    nlon = tointeger(BoxDiag(1)/dlon+1)
+
+    lat = fspan(0.0,BoxDiag(0),nlat)
+    lon = fspan(0.0,BoxDiag(1),nlon)
+  else if(grid_type.eq."gaussian") then
+    gau_info = gaus(nlat/2)
+    lat      = gau_info(:,0)  ; gaussian latitudes
+    lon      = todouble((/lonGlobeFo(nlon,"","","")/))
+  end if
+  end if
+
+;---Generate the cell center Lat/Lon
+  grid_center_lat = conform_dims((/nlat, nlon/),lat,0)
+  grid_center_lon = conform_dims((/nlat, nlon/),lon,1)
+	
+  if(.not.isatt(Opt,"Mask2D")) then
+    Opt@Mask2D = onedtond(1,(/nlat,nlon/))
+  end if
+
+;---Rotate back the box, if needed.
+  if (Rot.ne.(0.0)) then
+      rotate_latlon(grid_center_lat,grid_center_lon,Rot)
+  end if
+
+;---Now that the rotation was successful translating it back.
+  if(grid_type.ne."gaussian") then
+    grid_center_lat = grid_center_lat + LLCorner(0)
+    grid_center_lon = grid_center_lon + LLCorner(1)
+  end if
+
+  Opt@Title = FTitle
+
+;---Make sure curvilinear_to_SCRIP doesn't print timings.
+  set_pt = False
+  if(isatt(Opt,"PrintTimings")) then
+    set_pt = True
+    orig_pt = Opt@PrintTimings
+    Opt@PrintTimings = False
+  end if
+  curvilinear_to_SCRIP(FName,grid_center_lat,grid_center_lon,Opt)
+
+  if(set_pt) then
+    Opt@PrintTimings = orig_pt
+  end if
+
+  if(PrintTimings) then
+    print_elapsed_time(start_time,"latlon_to_SCRIP")
+  end if
+end     ; of latlon_to_SCRIP(...)
+
+;======================================================================
+; Checks if the required dimensions in the SCRIP file are present
+;======================================================================
+undef("check_SCRIP_dims")
+function check_SCRIP_dims(fid[1]:file,verbose[1]:logical)
+local i, file_dims, scrip_dim_names
+begin
+  file_dims       = getvardims(fid) 
+  scrip_dim_names = (/"grid_rank","grid_size","grid_corners"/)
+  do i=0,dimsizes(scrip_dim_names)-1
+    if (.not.(any(file_dims.eq.scrip_dim_names(i))))
+      if(verbose) then
+        print("check_SCRIP_dims: " + scrip_dim_names(i) + " not defined.")
+      end if
+      return(False)
+    end if
+  end do
+  return(True)
+end     ; of check_SCRIP_dims(...)
+
+;======================================================================
+; Checks if the required variables in SCRIP file are present
+;======================================================================
+undef("check_SCRIP_vars")
+function check_SCRIP_vars(fid[1]:file,verbose[1]:logical)
+local i, scrip_vars
+begin
+  scrip_vars = (/"grid_dims",  "grid_center_lat", "grid_center_lon",\
+                 "grid_imask", "grid_corner_lat", "grid_corner_lon"/)
+  do i=0,dimsizes(scrip_vars)-1
+    if(.not.(isfilevar(fid,scrip_vars(i))))
+      if(verbose) then
+        print("check_SCRIP_vars: " + scrip_vars(i) + " not defined.")
+      end if
+      return(False)
+    end if
+  end do
+  return(True)
+end     ; check_SCRIP_vars(...)
+
+;======================================================================
+; Checks if the input filename is following SCRIP standard
+;======================================================================
+undef("is_SCRIP")
+function is_SCRIP(FileName[1]:string,verbose[1]:logical)
+local fid
+begin
+    if (.not.isfilepresent(FileName)) then
+      if(verbose) then
+        print("is_SCRIP: '" + FileName + "' doesn't exist.")
+      end if
+      return(False)
+    end if
+    fid = addfile(FileName,"r")
+    return check_SCRIP_dims(fid,verbose).and.check_SCRIP_vars(fid,verbose)
+
+end     ; of is_SCRIP(...)
+
+;======================================================================
+; Checks if the required dimensions in the ESMF file are present
+;======================================================================
+undef("check_ESMF_dims")
+function check_ESMF_dims(fid[1]:file,verbose[1]:logical)
+local i, esmf_dim_names, file_dims
+begin
+  file_dims      = getvardims(fid) 
+  esmf_dim_names = (/"nodeCount", "elementCount", \
+                     "maxNodePElement","coordDim"/)
+   
+  do i=0,dimsizes(esmf_dim_names)-1
+    if (.not.(any(file_dims.eq.esmf_dim_names(i))))
+      if(verbose) then
+        print("check_ESMF_dims: " + esmf_dim_names(i) + " not defined.")
+      end if
+      return(False)
+    end if
+  end do
+  return(True)
+end     ; of check_ESMF_dims(...)
+
+;======================================================================
+; Checks if the required variables in ESMF file are present
+;======================================================================
+undef("check_ESMF_vars")
+function check_ESMF_vars(fid[1]:file,verbose[1]:logical)
+local i, esmf_vars
+begin
+  esmf_vars = (/"nodeCoords","elementConn","numElementConn",\
+                "centerCoords","elementArea","elementMask"/)
+
+  do i=0,dimsizes(esmf_vars)-1
+    if(.not.(isfilevar(fid,esmf_vars(i))))
+      if(verbose) then
+        print("check_ESMF_vars: " + esmf_vars(i) + " not defined.")
+      end if
+      return(False)
+    end if
+  end do
+  return(True)
+end     ; check_ESMF_vars(...)
+
+;======================================================================
+; Checks if the input filename is following ESMF standard
+;======================================================================
+undef("is_ESMF")
+function is_ESMF(FileName[1]:string,verbose[1]:logical)
+local fid
+begin
+    if (.not.isfilepresent(FileName)) then
+      if(verbose) then
+        print("is_ESMF: '" + FileName + "' doesn't exist.")
+      end if
+      return(False)
+    end if
+    fid = addfile(FileName,"r")
+    return check_ESMF_dims(fid,verbose).and.check_ESMF_vars(fid,verbose)
+
+end     ; of is_ESMF(...)
+
+;======================================================================
+; This function will retrieve the latitude coordinate of a grid
+; from a SCRIP formatted file.
+;
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.
+;======================================================================
+undef("retrieve_SCRIP_lat")
+function retrieve_SCRIP_lat(fileName[1]:string)
+local fid, grid_dims, grid_center_lat
+begin
+  if (.not.isfilepresent(fileName)) then
+    print("retrieve_SCRIP_lat: cannot open '" + fileName + "'.") 
+    exit
+  end if
+    
+  fid             = addfile(fileName,"r")
+  grid_dims       = fid->grid_dims
+  grid_center_lat = reshape( fid->grid_center_lat , grid_dims(::-1))
+  grid_center_lat@units="degrees_north"
+
+  return(grid_center_lat)
+end     ; of retrieve_SCRIP_lat
+
+;======================================================================
+; This function will retrieve the longitude coordinate of a grid
+; from a SCRIP file.
+;
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.
+;======================================================================
+undef("retrieve_SCRIP_lon")
+function retrieve_SCRIP_lon(fileName[1]:string)
+local fid, grid_dims, grid_center_lon
+begin
+  if (.not.isfilepresent(fileName)) then
+    print("retrieve_SCRIP_lon: cannot open '" + fileName + "'.")
+    exit
+  end if
+
+  fid             = addfile(fileName,"r")
+  grid_dims       = fid->grid_dims;
+  grid_center_lon = reshape( fid->grid_center_lon , grid_dims(::-1))
+  grid_center_lon@units="degrees_east"
+
+  return(grid_center_lon)
+end     ; of retrieve_SCRIP_lon
+
+;======================================================================
+; This function will retrieve the latitude values from an ESMF 
+; formatted file.
+;
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.
+;======================================================================
+undef("retrieve_ESMF_lat")
+function retrieve_ESMF_lat(fileName[1]:string)
+local fid, grid_center_lon
+begin
+  if (.not.isfilepresent(fileName)) then
+    print("retrieve_ESMF_lat: cannot open '"+ fileName + "'.")
+    exit
+  end if
+    
+  fid              = addfile(fileName,"r")
+  grid_center_lat  = fid->centerCoords(:,1)
+  grid_center_lat@units="degrees_north"
+
+  return(grid_center_lat)
+end     ; of retrieve_ESMF_lat
+
+;======================================================================
+; This function will retrieve the longitude values from an ESMF 
+; formatted file.
+;
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.
+;======================================================================
+undef("retrieve_ESMF_lon")
+function retrieve_ESMF_lon(fileName[1]:string)
+local fid, grid_center_lon
+begin
+  if (.not.isfilepresent(fileName)) then
+      print("retrieve_ESMF_lon: cannot open '" + fileName + "'.")
+      exit
+  end if
+
+  fid             = addfile(fileName,"r")
+  grid_center_lon = fid->centerCoords(:,0)
+  grid_center_lon@units="degrees_east"
+
+  return(grid_center_lon)
+end     ; of retrieve_ESMF_lon
+
+;======================================================================
+; This procedure will retrieve the destination lat/lon values from a
+; weights file generated by ESMF_RegridWeightGen and attach them
+; to the given variable. Since rectilinear lat/lon grids are written
+; as 2D arrays, you can't tell if it's rectilinear or curvilinear,
+; unless you test for repetitive values.
+; 
+; To force this routine to not check for "rectilinear-ness", you
+; can set opt@DstGridType to "rectilinear".
+;
+; There's no standard way to attached unstructured lat/lon data to
+; a variable, so we do it by "lat1d" and "lon1d" undef.
+;======================================================================
+undef("ESMF_copy_varcoords")
+procedure ESMF_copy_varcoords(sd:numeric,sd_regrid:numeric,\
+                              wgt_file_name[1]:string,opt[1]:logical)
+local fwgt, src_dims, src_ranks, dst_dims, dst_rank, mlon, nlat, i, ii, \
+      dst_grid_dims, dst_grid_rank, lat, lon, nleftmost, nleftdims, DEBUG
+begin
+  DEBUG = isatt_logical_true(opt,"Debug")
+
+;---Error checking
+  if (.not.isfilepresent(wgt_file_name)) then
+    print("Warning: ESMF_copy_varcoords: cannot open '" + wgt_file_name + "'.") 
+    print("         No coordinate information will be added.")
+    return
+  end if
+
+;---Get size of source and destination grids from weight file
+  fwgt          = addfile(wgt_file_name, "r")
+  src_grid_dims = fwgt->src_grid_dims(::-1)    ; dimensions are Fortran based
+  dst_grid_dims = fwgt->dst_grid_dims(::-1)
+  src_grid_rank = dimsizes(src_grid_dims)
+  dst_grid_rank = dimsizes(dst_grid_dims)
+
+;---More error checking
+  if(dst_grid_rank.ne.1.and.dst_grid_rank.ne.2) then
+    print("Warning: ESMF_copy_varcoords: the rank of the lat/lon values")
+    print("         on the weights file must be 1 or 2.")
+    print("         No coordinate information will be added.")
+    return
+  end if
+
+  if(isatt(opt,"DstGridType")) then
+    if(check_grid_type(opt@DstGridType).eq."none") then
+      print("Warning: ESMF_copy_varcoords: don't recognize the grid type")
+      print("         specified: '" + opt@DstGridType + "'.")
+      print("         No coordinate information will be added.")
+      return
+    end if
+    if(opt@DstGridType.eq."unstructured".and.dst_grid_rank.ne.1) then
+      print("Warning: ESMF_copy_varcoords: you specified an unstructured")
+      print("         grid, but your lat/lon coordinates appear to be") 
+      print("         curvilinear or rectilinear.")
+      print("         No coordinate information will be added.")
+      return
+    end if
+    if(any(opt@DstGridType.eq.(/"curvilinear","rectilinear"/)).and.\
+       dst_grid_rank.ne.2) then
+      print("Warning: ESMF_copy_varcoords: you specified a rectilinear")
+      print("         or curvilinear grid, but your lat/lon coordinates")
+      print("         appear to be unstructured.")
+      print("         No coordinate information will be added.")
+      return
+    end if
+  end if
+
+;---Get size of original and regridded variables
+  src_dims = dimsizes(sd)
+  src_rank = dimsizes(src_dims)
+  dst_dims = dimsizes(sd_regrid)
+  dst_rank = dimsizes(dst_dims)
+
+;---Both grids must have the same leftmost dimemsions
+  if((src_rank-src_grid_rank).ne.(dst_rank-dst_grid_rank)) then
+    print("Warning: ESMF_copy_varcoords: the dimension sizes of your")
+    print("         source and destination grids don't match up.")
+    print("         No coordinate information will be added.")
+    return
+  end if
+;---Make sure leftmost dimensions are same size.
+  nleftdims = src_rank-src_grid_rank
+  do i=0,nleftdims-1
+    if(src_dims(i).ne.dst_dims(i)) then
+      print("Warning: ESMF_copy_varcoords: the dimension sizes of your")
+      print("         source and destination grids don't match up.")
+      print("         No coordinate information will be added.")
+      return
+    end if
+  end do
+
+;---Done with error checking. Copy the leftmost coordinates, if any.
+  if(nleftdims.gt.0) then
+    ii = ispan(0,nleftdims-1,1)
+    copy_VarCoords_n(sd,sd_regrid,ii)
+  end if
+;
+; Test for what kind of coordinate information to add.
+; 
+  if (dst_grid_rank.eq.1) then
+    sd_regrid@lat1d = fwgt->yc_b      ; I don't like this, but how else to 
+    sd_regrid@lon1d = fwgt->xc_b      ; attach?
+    return
+  end if
+
+;---dst_grid_rank must be 2
+  nlat = dst_grid_dims(0)
+  mlon = dst_grid_dims(1)
+
+  if(isatt(opt,"DstGridType").and.opt@DstGridType.eq."curvilinear") then
+    sd_regrid@lat2d = reshape(fwgt->yc_b,(/nlat,mlon/))
+    sd_regrid@lon2d = reshape(fwgt->xc_b,(/nlat,mlon/))
+    return
+  end if
+;
+; If DstGridType not specified, then we have to check if these are
+; rectilinear coordinates. This can be an expensive operation.
+; I'm not sure if this should be the default.
+;
+  is_rectilinear = isatt(opt,"DstGridType").and.\
+                   opt@DstGridType.eq."rectilinear"
+
+  lat = fwgt->yc_b(0::mlon)
+  lon = fwgt->xc_b(0:mlon-1)
+
+  if(.not.is_rectilinear) then
+     tmplat    = fwgt->yc_b(nlat/2::mlon)
+     tmplon    = fwgt->xc_b(mlon:2*mlon-1)
+     nlat_test = dimsizes(lat)
+     nlon_test = dimsizes(lon)
+     nlat_tmp  = dimsizes(tmplat)
+     nlon_tmp  = dimsizes(tmplon)
+;---Test for "rectilinear-ness"
+     if (nlat_test.eq.nlat_tmp.and.nlon_test.eq.nlon_tmp.and.\
+         all(lat.eq.tmplat).and.all(lon.eq.tmplon)) then
+       if(DEBUG) then
+         print("ESMF_copy_varcoords: detected a rectilinear grid.")
+         dq = str_get_dq()
+         print("      If you know your grid is rectilinear, then set")
+         print("      opt@DstGridType = " + dq + "rectilinear" + dq + " to")
+         print("      prevent this potentially slow test.")
+       end if
+       is_rectilinear = True
+     else
+       sd_regrid@lat2d = reshape(fwgt->yc_b,(/nlat,mlon/))
+       sd_regrid@lon2d = reshape(fwgt->xc_b,(/nlat,mlon/))
+       return
+     end if
+     delete([/tmplat,tmplon/])
+  end if
+
+;---Must be rectilinear!
+  lat@long_name = "latitude"
+  lat@units     = "degrees_north"
+  lat!0         = "lat"
+  lat&lat       =  lat
+
+  lon  = fwgt->xc_b(0:mlon-1)
+  lon@long_name = "longitude"
+  lon@units     = "degrees_east"
+  lon!0         = "lon"
+  lon&lon       =  lon
+    
+  dst_dims = dimsizes(sd_regrid)
+  dst_rank = dimsizes(dst_dims)
+  sd_regrid!(dst_rank-2) = "lat"
+  sd_regrid!(dst_rank-1) = "lon"
+  sd_regrid&lat         = lat
+  sd_regrid&lon         = lon
+  return
+end
+
+
+;======================================================================
+; This procedure copies attributes from the original variable to
+; the regridded variable, and attaches coordinate information, if
+; available. It will not copy lat1d/lon1d or lat2d/lon2d attributes.
+;
+; The coordinate information is retrieved from the weights file.
+;
+; I think this procedure needs to have added to it the ability to
+; have a "coordinates" attribute for the case of curvilinear grids.
+;======================================================================
+undef("ESMF_copy_varmeta")
+procedure ESMF_copy_varmeta(sd,sd_regrid,wgt_file_name[1]:string, \
+                            opt[1]:logical)
+local var_dims, var_rank, dstlat, dstlon, atts_to_skip, natts
+begin
+  var_dims = dimsizes(sd_regrid)
+  var_rank = dimsizes(var_dims)
+
+;---Copy variable attributes, unless requested otherwise (True by default)
+  if(.not.isatt_logical_false(opt,"CopyVarAtts").and.\
+     .not.isatt_logical_false(opt,"CopyVarMeta")) then
+    atts_to_skip = (/"lat1d","lon1d","lat2d","lon2d","coordinates"/)
+    if(isatt(opt,"CopyVarAttsExcept")) then
+      natts            = dimsizes(atts_to_skip)
+      new_atts_to_skip = new(natts+dimsizes(opt@CopyVarAttsExcept),string)
+      new_atts_to_skip(0:natts-1) = atts_to_skip      
+      new_atts_to_skip(natts:)    = opt@CopyVarAttsExcept
+      copy_VarAtts_except(sd,sd_regrid,new_atts_to_skip)
+    else
+      copy_VarAtts_except(sd,sd_regrid,atts_to_skip)
+    end if
+    if(.not.any("_FillValue".eq.atts_to_skip).and.isatt(sd,"_FillValue").and. \
+       .not.isatt(sd_regrid,"_FillValue")) then
+      sd_regrid@_FillValue = sd@_FillValue
+    end if
+  end if
+
+;---Create variable coords, unless requested otherwise (True by default)
+  if(.not.isatt_logical_false(opt,"CopyVarCoords").and.\
+     .not.isatt_logical_false(opt,"CopyVarMeta")) then
+    ESMF_copy_varcoords(sd,sd_regrid,wgt_file_name,opt)
+  end if
+end
+
+;======================================================================
+; This procedure calls the UNIX command "ESMF_RegridWeightGen".
+;
+;  srcGridFile - the name of the NetCDF source grid file (ESMF or SCRIP)
+;  dstGridFile - the name of the NetCDF destination grid file (ESMF or SCRIP)
+;  wgtFile     - the name of the NetCDF weight file to create.
+;  opt         - Set to True to indicate optional attributes are attached.
+;
+;  The following attributes are allowed with "opt":
+;        Debug - Turns on debug print statements
+;           True or False (default=False)
+;        SrcESMF - whether only the src grid file is an ESMF file
+;           True or False (default=False)
+;        DstESMF - whether only the dst grid file is an ESMF file
+;           True or False (default=False)
+;        SrcRegional - whether only the src grid file is regional
+;           True or False (default=False)
+;        DstRegional - whether only the dst grid file is regional
+;           True or False (default=False)
+;        IgnoreUnmappedPoints - whether to ignore unmapped points
+;           True or False (default=True)
+;        InterpMethod ("method" will work too)
+;           "bilinear" (default), "patch" (slow), "conserve"
+;        Pole ("pole" will work too)
+;           "all" (default, unless InterpMethod=conserve), "none"
+;        RemoveSrcFile
+;           True or False (default=False)
+;           Whether to remove srcGridFile after the
+;             weight generation is done.
+;        RemoveDstFile
+;           True or False (default=False)
+;           Whether to remove dstGridFile after the
+;             weight generation is done.
+;        RemoveFiles
+;           True or False (default=False)
+;           Whether to remove both src and dst grid files
+;             after the weight generation is done.
+;
+; The ESMFBINDIR environment variable can be set  prior to calling 
+; this procedure, in order to indicate the location of this binary.
+;
+; The NumProc env var can be set to indicate the number of
+; processors, if the ESMF software was built with MPI turned on.
+;
+;======================================================================
+undef("ESMF_regrid_gen_weights")
+procedure ESMF_regrid_gen_weights(srcGridFile[1]:string, dstGridFile[1]:string, \
+                           wgtFile[1]:string, opt[1]:logical)
+local DEBUG, NumProc, Executer, ESMFCMD, ESMF_exec, interp_method, pole, opt
+begin
+  valid_interp_methods = (/"bilinear","patch","conserve", \
+                           "nearestdtos","neareststod"/)
+;
+; Some attribute options cannot both be set if they have
+; different values.  Check for them here.
+;
+  opt2 = opt
+  check_both_atts(opt2,"RemoveFiles","RemoveDstFile",False)
+  check_both_atts(opt2,"RemoveFiles","RemoveSrcFile",False)
+  check_both_atts(opt2,"WgtForceOverwrite","ForceOverwrite",False)
+  check_both_atts(opt2,"WgtOverwrite","Overwrite",False)
+
+  if(isatt_logical_true(opt2,"RemoveDstFile"))
+    print("ESMF_regrid_gen_weights: Warning: RemoveDstFile was set to True.")
+    print("  This file might be needed later to generate coordinates.")
+  end if
+
+  if(isatt_logical_true(opt2,"WgtOverwrite")) then
+    opt2@Overwrite = True
+  end if
+
+  if(isatt_logical_true(opt2,"WgtForceOverwrite")) then
+    opt2@ForceOverwrite = True
+  end if
+
+;---Name of ESMF offline regridder
+  ESMF_exec = "ESMF_RegridWeightGen"
+
+;---Check for options
+  PrintTimings   = isatt_logical_true(opt2,"PrintTimings")
+  if(PrintTimings) then
+    start_time = get_start_time()
+  end if
+
+  DEBUG          = isatt_logical_true(opt2,"Debug")
+  REMOVE_PET_LOG = isatt_logical_true(opt2,"RemovePETLog")
+
+;---Check if the source grid file is a SCRIP file.
+  if (.not.(isatt_logical_true(opt2,"SrcESMF")).and. \
+      .not.(is_SCRIP(srcGridFile,True))) then
+    print("ESMF_regrid_gen_weights: invalid or missing SCRIP source grid file.")
+    exit
+  end if
+
+;---Check if the source grid file is an ESMF file.
+  if (isatt_logical_true(opt2,"SrcESMF").and. \
+      .not.(is_ESMF(srcGridFile,True))) then
+    print("ESMF_regrid_gen_weights: invalid or missing ESMF source grid file.")
+    exit
+  end if
+
+;---Check if the destination grid file is a SCRIP file.
+  if (.not.(isatt_logical_true(opt2,"DstESMF")).and. \
+      .not.(is_SCRIP(dstGridFile,True))) then
+    print("ESMF_regrid_gen_weights: invalid or missing SCRIP destination grid file.")
+    exit
+  end if
+
+;---Check if the destination grid file is a ESMF file.
+  if (isatt_logical_true(opt2,"DstESMF").and. \
+      .not.(is_ESMF(dstGridFile,True))) then
+    print("ESMF_regrid_gen_weights: invalid or missing ESMF destination grid file.")
+    exit
+  end if
+
+;
+; All seems ok. Run the ESMF regrid weight generator.
+;
+; Check the number of processor supported by the system.
+;
+; The user must have compiled ESMF with parallel features.
+;
+  if(ismissing(getenv("NumProc"))) then  
+    NumProc  = 1
+    Executer = ""
+  else 
+    NumProc = getenv("NumProc")
+    Executer = "mpirun -n " +NumProc+" "
+  end if
+  if(DEBUG) then
+    print("ESMF_regrid_gen_weights: number of processors used: " + NumProc)
+  end if
+
+;---Check if the weight file already exists.
+  check_for_file(wgtFile,opt2)
+
+;---Build the command (First Pass - non-optional features)
+  if (ismissing(getenv("ESMFBINDIR"))) then
+    ESMFCMD = Executer + ESMF_exec + " " \
+              + "--source " + srcGridFile \
+              + " --destination " + dstGridFile \
+              + " --weight "+ wgtFile
+  else 
+    ESMFCMD = Executer + "$ESMFBINDIR/" + ESMF_exec + " " \
+              + "--source " + srcGridFile \
+              + " --destination " + dstGridFile \
+              + " --weight " + wgtFile
+  end if
+
+;---Check for options
+  if (opt2) then
+;
+; Check if the user has requested a certain method.
+; Otherwise, the default will be used.
+;
+    if (isatt(opt2,"InterpMethod")) then
+      interp_method = str_lower(opt2@InterpMethod)
+    end if
+    if (isatt(opt2,"method")) then
+      interp_method = str_lower(opt2@method)
+    end if
+    if (isvar("interp_method")) then
+      if(.not.any(interp_method.eq.valid_interp_methods)) then
+        print("ESMF_regrid_gen_weights: InterpMethod must be one of " + \
+              str_join(valid_interp_methods,", "))
+        exit
+      end if
+      ESMFCMD = ESMFCMD + " --method " + interp_method
+    end if
+;
+; Check if the user has specified how to handle the poles
+; Otherwise, the default will be used.
+;
+    if (isatt(opt2,"Pole")) then
+      pole = str_lower(opt2@Pole)
+    end if
+    if (isatt(opt2,"pole")) then
+      pole = str_lower(opt2@pole)
+    end if
+    if(isvar("interp_method").and.isvar("pole").and.pole.eq."all".and.\
+       any(interp_method.eq.(/"conserve","neareststod","nearestdtos"/))) then
+      print("ESMF_regrid_gen_weights: warning: 'Pole' cannot be set to 'all' when") 
+      print("                  using 'conserve' method. Defaulting to 'none'.")
+      pole = "none"      
+    end if
+
+    if (isvar("pole")) then
+      ESMFCMD = ESMFCMD + " --pole " + pole
+    end if
+
+;---Check if the user specifies that source grid is regional
+    if (isatt_logical_true(opt2,"SrcRegional")) then
+      ESMFCMD = ESMFCMD + " --src_regional"
+    end if
+
+;---Check if the user specifies that destination grid is regional
+    if (isatt_logical_true(opt2,"DstRegional")) then
+      ESMFCMD = ESMFCMD + " --dst_regional"
+    end if
+
+;---Checking if the user specifies that source grid is ESMF
+    if (isatt_logical_true(opt2,"SrcESMF")) then
+        ESMFCMD = ESMFCMD + " --src_type ESMF"
+    end if
+
+;---Check if the user specifies that destination grid is ESMF
+    if (isatt_logical_true(opt2,"DstESMF")) then
+      ESMFCMD = ESMFCMD + " --dst_type ESMF"
+    end if
+
+;---This flag is necessary for V5.2.0r1 and grids like WRF.
+    if (.not.isatt_logical_false(opt2,"IgnoreUnmappedPoints")) then
+        ESMFCMD = ESMFCMD + " -i"
+    end if
+
+;---This flag is necessary for writing vars > 2 GB
+    if (isatt_logical_true(opt2,"LargeFile")) then
+        ESMFCMD = ESMFCMD + " --64bit_offset"
+    end if
+
+;---Check if the user has requested to print out the full command to be run.
+  end if  ; end of building the command (Second Pass - optional features)
+		
+  if (DEBUG)
+    print("--------------------------------------------------")
+    print("ESMF_regrid_gen_weights: the following command is about to be executed on the system:")
+    print("'"+ESMFCMD+"'")
+    print("--------------------------------------------------")
+  end if
+
+;---Execute the regridding command
+  RegridOut = systemfunc(ESMFCMD)
+        
+  if(REMOVE_PET_LOG) then
+    system("rm -rf PET0.RegridWeightGen.Log")
+  end if
+
+  if(DEBUG) then
+    print("ESMF_regrid_gen_weights: output from '" + ESMF_exec + "':")
+    print("     " + RegridOut)
+    print("--------------------------------------------------")
+  end if
+;
+; The binary tool performs more sophisticated tests.
+; Here it is checked that everything went ok.
+;
+  if (.not.(any(str_squeeze(RegridOut).eq. \
+            "Completed weight generation successfully."))) then
+    print("ESMF_regrid_gen_weights: '" + ESMF_exec + "' was not successful.")
+    exit
+  end if
+  if(DEBUG) then
+    print("ESMF_regrid_gen_weights: '" + ESMF_exec + "' was successful.")
+  end if    
+
+;
+; Clean up, if desired. We don't allow for the removal of the weight
+; file here because it might be needed later to generate coordinate
+; information. We might decide to change this.
+;
+  if (isatt_logical_true(opt2,"RemoveFiles").or. \
+      isatt_logical_true(opt2,"RemoveSrcFile")) then
+    if(DEBUG) then
+      print("ESMF_regrid_gen_weights: By request, removing '" + srcGridFile + "'")
+    end if    
+    system("rm -rf " + srcGridFile)
+  end if
+
+  if (isatt_logical_true(opt2,"RemoveFiles").or. \
+      isatt_logical_true(opt2,"RemoveDstFile")) then
+    if(DEBUG) then
+      print("ESMF_regrid_gen_weights: By request, removing '" + dstGridFile + "'")
+    end if    
+    system("rm -rf " + dstGridFile)
+  end if
+
+  if(PrintTimings) then
+    print_elapsed_time(start_time,"ESMF_regrid_gen_weights")
+  end if
+
+end     ; of ESMF_regrid_gen_weights(...)
+
+;======================================================================
+; Using the provided weight file, remaps the data 
+; from source grid into destination grid
+;
+; I've been tempted to add options for removing the source, destination,
+; and weight files after this routine is done. But, ESMF_regrid can
+; do this, so it's easier to let this routine "do it all" than to
+; have the individual functions do it.
+;======================================================================
+undef("ESMF_regrid_with_weights")
+function ESMF_regrid_with_weights(srcData:numeric,wgtFile[1]:string, opt[1]:logical)
+local DEBUG, fmsg, fid, srclat, srclon, dstlat, dstlon, src_grid_dims, \
+      src_grid_rank, srcData_dims, srcData_rank, srcData_rgt_dims, \
+      srcData_lft_dims, has_leftmost_dims, dst_grid_dims, dst_grid_rank, \
+      dst_grid_dims_in, row, col, v, x, minDataValue, maxDataValue, \
+      RemapIndexes, Indexes, IndexesDims, dstData_tmp2d
+begin
+  fmsg  = new(1,float)                         ; For error return
+
+;---Check for options
+  PrintTimings = isatt_logical_true(opt,"PrintTimings")
+  DEBUG        = isatt_logical_true(opt,"Debug")
+;
+; If the input type is float, and the user hasn't explicitly set
+; ReturnDouble to True, then floats will be returned.
+;
+  if(typeof(srcData).ne."double".and.\
+     .not.isatt_logical_true(opt,"ReturnDouble")) then
+    ReturnFloat = True
+  else
+    ReturnFloat = False
+  end if
+
+  if(PrintTimings) then
+    start_time = get_start_time()
+  end if
+
+;
+; Check if the indexes on the file actually represent indexes
+; into a larger 2D grid. If so, we have get the Indexes and
+; the dimension sizes of the larger 2D grid, for remapping
+; later.
+;
+  RemapIndexes = isatt_logical_true(opt,"RemapIndexes")
+  if(RemapIndexes) then
+    if(isatt(opt,"Indexes")) then
+      Indexes = opt@Indexes
+    else
+      print("ESMF_regrid_with_weights: error: you set RemapIndexes=True, but didn't provide 'Indexes'.")
+      exit
+    end if
+    if(isatt(opt,"IndexesDims")) then
+      IndexesDims = opt@IndexesDims
+    else
+      print("ESMF_regrid_with_weights: error: you set RemapIndexes=True, but didn't provide the ")
+      print("                          dimension sizes of the nD array (IndexesDims")
+      exit
+    end if
+  end if
+
+  if(DEBUG) then
+    print("ESMF_regrid_with_weights: regridding using interpolation weights ...")
+  end if
+
+;---Make sure the weight file is accessible
+  map_method = "unknown"
+  if (.not.(isfilepresent(wgtFile))) then
+    print("ESMF_regrid_with_weights: cannot open weight file '" + \
+          wgtFile + "'.")
+    return(fmsg)
+  else
+    fid = addfile(wgtFile,"r")
+    if(isatt(fid,"map_method")) then
+      map_method = fid@map_method
+    end if
+;---Error checking
+    ns = getfilevardimsizes(fid,"S")
+    if(all(ismissing(ns)).or.all(ns.eq.0)) then
+      print("ESMF_regrid_with_weights: error: there are no weights on this file.")
+      print("    This likely means there was a problem with the mapping")
+      print("    from the source grid to the destination grid.")
+      print("    Check that both grids are valid.")
+      return(fmsg)
+    end if
+  end if
+
+;
+; Apply frac_b only for conservative interpolation. We may
+; change this later to let the user decide when to apply.
+; The ESMF folks said that it was only needed for the
+; "conserve" case, and they reconfirmed this Oct 2012.
+;
+  if(map_method.eq."Conservative remapping") then
+    ApplyFrac_B = True
+    frac_b = fid->frac_b
+    frac_b@_FillValue = default_fillvalue(typeof(frac_b))
+    frac_b = where(frac_b.eq.0,frac_b@_FillValue,frac_b)
+  else
+    ApplyFrac_B = False
+  end if
+
+;---Get the lat/lon of source and destination grids
+  srclat = fid->yc_a
+  srclon = fid->xc_a
+  dstlat = fid->yc_b
+  dstlon = fid->xc_b
+	
+;---Check that the source grid "covers" the destination grid 
+  if ( DEBUG.and..not.( \
+       (min(dstlat).ge.min(srclat)).and.  \
+       (max(dstlat).le.max(srclat)).and.  \
+       (min(dstlon).ge.min(srclon)).and.  \
+       (max(dstlon).le.max(srclon))   ) ) then
+      print("ESMF_regrid_with_weights: warning: destination grid is not")
+      print("    completely covered by the source grid. This is not an error.")
+      print("    It just means your destination grid covers a larger area")
+      print("    than your source grid.")
+  end if
+	
+;---Get the dimensions and rank of the source grid and input grid.
+  src_grid_dims = fid->src_grid_dims(::-1)    ; dimensions are Fortran-based
+  src_grid_rank = dimsizes(src_grid_dims)
+  is_src_grid_scalar = src_grid_rank.eq.1.and.src_grid_dims(0).eq.1
+
+  srcData_dims = dimsizes(srcData)
+  srcData_rank = dimsizes(srcData_dims)
+
+;---Get the dimensions and rank of the destination grid
+  dst_grid_dims = fid->dst_grid_dims(::-1)    ; dimensions are Fortran based
+  dst_grid_rank = dimsizes(dst_grid_dims)	
+
+;---Check dimensions of srcData
+  if(src_grid_rank.gt.srcData_rank) then
+    print("ESMF_regrid_with_weights: error: the rank of the source dimensions on the")
+    print("                          weight file is more than the rank of the data")
+    print("                          to be regridded. Can't continue.")
+    return(fmsg)
+  end if
+
+  if(DEBUG) then
+;---Source grid info
+    print("ESMF_regrid_with_weights: Source Grid:")
+    print("                          rank:      " + src_grid_rank)
+    str = "                          dimensions:"
+    do i=0,src_grid_rank-1
+      str = str + " " + src_grid_dims(i)
+    end do
+    print("" + str)
+    print("                          original source rank: " + srcData_rank)
+    print("                          latitude min/max: " + min(srclat) + "/" + max(srclat))
+    print("                          longitude min/max:" + min(srclon) + "/" + max(srclon))
+;---Destination grid info
+    print("ESMF_regrid_with_weights: Destination Grid:")
+    str = "                          dimensions:"
+    do i=0,dst_grid_rank-1
+      str = str + " " + dst_grid_dims(i)
+    end do
+    print("" + str)
+    print("                          latitude min/max: " + min(dstlat) + "/" + max(dstlat))
+    print("                          longitude min/max:" + min(dstlon) + "/" + max(dstlon))
+  end if
+
+;
+; The source dimensions on the description file will not 
+; necessarily be the same as the original source dimensions
+; of the grid you want to regrid from. You have to take
+; that into account in this whole procedure, and make sure
+; you use the correct dimensions depending on what you're
+; doing.
+;
+  if(.not.is_src_grid_scalar.and.srcData_rank.gt.src_grid_rank) then
+    srcData_lft_ndims = srcData_rank - src_grid_rank
+    srcData_rgt_dims  = srcData_dims(srcData_lft_ndims:)
+    srcData_lft_dims  = srcData_dims(0:srcData_lft_ndims-1)
+  else
+    srcData_rgt_dims  = srcData_dims
+    srcData_lft_ndims = 0
+  end if
+
+;
+; Retrieve the interpolation weights. They are stored as a 
+; sparse matrix in a coordinate list format
+;
+  if(DEBUG) then
+    print("ESMF_regrid_with_weights: retrieving interpolation weights ...")
+  end if
+
+  row = fid->row
+  col = fid->col
+  v   = fid->S
+
+;---Check that the column indexes will map into src_grid_dims
+  if ( max(col).gt.product(srcData_rgt_dims) ) then
+    print("ESMF_regrid_with_weights: error: source data on the description")
+    print("     file does not have proper dimensions.")
+    return(fmsg)
+  end if
+    
+;
+; We have to convert the src grid to 1D no matter what.
+; However, we have to determine if there are any leftmost 
+; dimensions to account for.
+;
+  if(.not.is_src_grid_scalar.and.srcData_rank.gt.src_grid_rank) then
+    src_grid_dims_tmp                        = new(srcData_lft_ndims+1,long)
+    src_grid_dims_tmp(0:srcData_lft_ndims-1) = srcData_lft_dims
+    src_grid_dims_tmp(srcData_lft_ndims)     = product(srcData_rgt_dims)
+    x = reshape(srcData,src_grid_dims_tmp)
+  else
+    x = reshape(srcData,product(srcData_dims))
+  end if
+;
+; Note from Mohammad:
+;   Currently there is a problem with ESMF files.
+;   once it is fixed by ESMF people This can be reinstated.
+;  if( max(row).gt.product(dst_grid_dims) ) then  
+;    print("ESMF_regrid_with_weights: error: weight file has internal mistmatched data or is corrupted.")
+;    return(fmsg)
+;  end if
+      
+  if(DEBUG)
+    print("ESMF_regrid_with_weights: calling sparse_matrix_mult to apply weights...")
+  end if
+
+;
+; We have to always treat the output grid as a 1D array
+; of length N because ESMF gives us the indices into a
+; 1D array. 
+;
+; If dst_grid_dims is 1, then we have to set N=max(row).
+;
+  if(dst_grid_rank.eq.1) then
+    dst_grid_dims_in = max(row)
+  else
+    dst_grid_dims_in = product(dst_grid_dims)
+  end if
+  dst_grid_dims_in = product(dst_grid_dims)
+;
+; We will need to reshape the return (M) x N grid from
+; sparse_matrix_mult if the output dimensions are not 1D.
+;
+; We also need to divide by frac_b if using the "conserve"
+; method. We are trying to avoid making a separate copy
+; of the array, if float return is desired. So, we have
+; 8 special "if" tests to avoid this as much as possible:
+;
+; Return array has to be reshaped and converted to float
+;   Case 1: Apply frac_b
+;   Case 2: Don't apply frac_b
+; Return array has to be reshaped, but leave as double
+;   Case 3: Apply frac_b
+;   Case 4: Don't apply frac_b
+; Return array has to be converted to float (no reshaping)
+;   Case 5: Apply frac_b
+;   Case 6: Don't apply frac_b
+; Return array left as double (no reshaping)
+;   Case 7: Apply frac_b, convert to float
+;   Case 8: Convert to float
+;
+  if(ApplyFrac_B.and.DEBUG) then 
+    print("ESMF_regrid_with_weights: dividing results by frac_b...")
+    print("            (currently for conserve interpolation only)")
+  end if
+
+  if(dst_grid_rank.gt.1) then
+    dst_grid_dims_out = new(srcData_lft_ndims+dst_grid_rank,long)
+    if(.not.is_src_grid_scalar.and.srcData_rank.gt.src_grid_rank) then
+      dst_grid_dims_out(0:srcData_lft_ndims-1) = srcData_lft_dims
+    end if
+    dst_grid_dims_out(srcData_lft_ndims:) = dst_grid_dims
+    if(ReturnFloat) then
+;---Case 1: Apply frac_b, reshape, convert to float
+      if(ApplyFrac_B) then
+        dstData = tofloat(reshape(sparse_matrix_mult(row-1,col-1,v,x,\
+                  dst_grid_dims_in),dst_grid_dims_out) / \
+                  reshape(frac_b,dst_grid_dims_out))
+      else
+;---Case 2: Reshape, convert to float
+        dstData = tofloat(reshape(sparse_matrix_mult(row-1,col-1,v,x,\
+                  dst_grid_dims_in),dst_grid_dims_out))
+      end if
+    else
+;---Case 3: Apply frac_b, reshape, leave as double
+      if(ApplyFrac_B) then
+        dstData = reshape(sparse_matrix_mult(row-1,col-1,v,x,\
+                  dst_grid_dims_in),dst_grid_dims_out) / \
+                  reshape(frac_b,dst_grid_dims_out)
+      else
+;---Case 4: Reshape, leave as double
+        dstData = reshape(sparse_matrix_mult(row-1,col-1,v,x,\
+                  dst_grid_dims_in),dst_grid_dims_out)
+      end if
+    end if
+  else
+    if(ReturnFloat) then
+;---Case 5: Apply frac_b, convert to float (no reshape)
+      if(ApplyFrac_B) then
+        dstData = tofloat(sparse_matrix_mult(row-1,col-1,v,x,\
+                  dst_grid_dims_in)/frac_b)
+      else
+;---Case 6: Convert to float (no reshape)
+        dstData = tofloat(sparse_matrix_mult(row-1,col-1,v,x,dst_grid_dims_in))
+      end if
+    else
+;---Case 7: Apply frac_b, leave as double (no reshape)
+      if(ApplyFrac_B) then
+        dstData = sparse_matrix_mult(row-1,col-1,v,x,dst_grid_dims_in)/frac_b
+      else
+;---Case 8: Leave as double (no reshape)
+        dstData = sparse_matrix_mult(row-1,col-1,v,x,dst_grid_dims_in)
+      end if
+    end if
+  end if
+
+;---Clean up to save memory
+  if(ApplyFrac_B) then
+    delete(frac_b)
+  end if
+
+;---Make sure dstData has a missing value
+  if(isatt(srcData,"_FillValue")) then
+    dstData@_FillValue = totypeof(srcData@_FillValue,typeof(dstData))
+  else
+    dstData@_FillValue = default_fillvalue(typeof(dstData))
+  end if
+
+;---Check if we need to remap the values onto a larger 2D grid.
+  if(RemapIndexes) then
+    if(DEBUG)
+      print("ESMF_regrid_with_weights: putting interpolated values back onto larger 2D grid...")
+    end if
+    dstData_tmp2d = reshape_ind(dstData,Indexes,IndexesDims)
+    delete(dstData)
+    dstData = dstData_tmp2d
+  end if
+
+  if(DEBUG) then
+    print("ESMF_regrid_with_weights: dstData")
+    str = "                          Dimensions:"
+    nd = dimsizes(dstData)
+    do i=0,dimsizes(nd)-1
+      str = str + " " + nd(i)
+    end do
+    print("" + str)
+    print("                          minSrcData: " + min(srcData))
+    print("                          maxSrcData: " + max(srcData))
+    print("                          minDstData: " + min(dstData))
+    print("                          maxDstData: " + max(dstData))
+  end if
+
+;---Copy variable attributes and coordinate arrays if requested.
+  delete(fid)    ; close weight file before it gets opened again
+  ESMF_copy_varmeta(srcData,dstData,wgtFile,opt)
+
+;----------------------------------------------------------------------
+; Clean up, add, and remove attributes.
+;
+; Note that due to standards for the weights file, the map_method
+; attribute will say "Bilinear remapping" for both bilinear and patch
+; methods. If this routine is called by ESMF_regrid, then that routine
+; will set FixMapMethodForPatch to True so this routine knows to fix
+; the "remap" attribute. Otherwise if ESMF_regrid_with_weights is
+; called directly, there's no way to tell if patch or bilinear was
+; used.
+;----------------------------------------------------------------------
+  if (.not.isatt(dstData,"remap")) then
+    if(isatt_logical_true(opt,"FixMapMethodForPatch")) then
+      dstData@remap = "remapped via ESMF_regrid_with_weights: " + \
+                       str_sub_str(map_method,"Bilinear","Patch")
+    else
+      dstData@remap = "remapped via ESMF_regrid_with_weights: " + \
+                      map_method
+    end if
+  end if
+
+;---Check for missing value attributes and fix them if necessary
+  if(.not.isatt(dstData,"missing_value")) then
+    dstData@missing_value = dstData@_FillValue
+  else
+    if(typeof(dstData@missing_value).ne.typeof(dstData)) then
+      tmp_msg = totypeof(dstData@missing_value,typeof(dstData))
+      delete(dstData@missing_value)
+      dstData@missing_value = tmp_msg
+    end if
+  end if
+
+  if(isatt(dstData,"_FillValue_original")) then
+    delete(dstData@_FillValue_original)
+  end if
+  if(isatt(dstData,"missing_value_original")) then
+    delete(dstData@missing_value_original)
+  end if
+
+  if(PrintTimings) then
+    print_elapsed_time(start_time,"ESMF_regrid_with_weights")
+  end if
+
+  return(dstData)
+end     ; of ESMF_regrid_with_weights(...)
+
+;----------------------------------------------------------------------
+; Note: this routine should be combined with "get_dst_grid_info" to
+; make just one "get_grid_info" routine. For now, any changes made to
+; this routine should potentially be done to "get_dst_grid_info".
+;
+; Given a source data variable, this function returns information 
+; about the source grid, and the lat/lon values, if appropriate.
+;
+; The lat/lon values can be provided via:
+;
+;   - SrcGridLat/SrcGridLon
+;
+;   - Coordinate arrays [rectilinear grid] 
+;
+;   - lat2d/lon2d attributes [curvilinear grid] 
+;
+;   - lat1d/lon1d attributes [unstructured grid] 
+;
+;   - By a grid type of "5deg", "1x1", "2x3", etc.
+;----------------------------------------------------------------------
+undef("get_src_grid_info")
+function get_src_grid_info(opt,data)
+local opt2, grid_type_name, grid_lat_name, grid_lon_name, islatlon, \
+      grid_string, lat_vals, lon_vals, lat_dims, lon_dims, slat_dims, slon_dims, \
+      lat_rank, lon_rank, var_dims, var_rank, left_dims, grid_long_string
+begin
+  opt2             = opt
+  grid_string      = "Src"
+  grid_long_string = "source"
+
+  DEBUG = isatt_logical_true(opt2,"Debug")
+
+  var_dims = dimsizes(data)
+  var_rank = dimsizes(var_dims)
+
+;---List of some of the possible attributes attached to "opt".
+  grid_type_name = grid_string + "GridType"
+  grid_lat_name  = grid_string + "GridLat"
+  grid_lon_name  = grid_string + "GridLon"
+
+  grid_type = str_lower(get_att_value(opt2,grid_type_name,"unknown"))
+
+;---Check if SrcGridLat/SrcGridLon were specified.
+  if(isatt(opt2,grid_lat_name).and.isatt(opt2,grid_lon_name)) then
+    islatlon = True
+    lat_vals = opt2@$grid_lat_name$
+    lon_vals = opt2@$grid_lon_name$
+
+;---Curvilinear grid?
+  else if(isatt(data,"lat2d").and.isatt(data,"lon2d")) then
+    if(.not.any(grid_type.eq.(/"unknown","curvilinear"/))) then
+      print("get_src_grid_info: the lat/lon values provided don't match")
+      print("                   the grid type (" + grid_type + ") specified.")
+      exit
+    end if
+    
+    grid_type = "curvilinear"
+    islatlon  = True
+    lat_vals  = data@lat2d
+    lon_vals  = data@lon2d
+    
+;---Rectilinear grid?
+  else if(var_rank.ge.2.and. \
+          isdimnamed(data,var_rank-1).and. \
+          isdimnamed(data,var_rank-2).and. \
+          iscoord(data,data!(var_rank-1)).and. \
+          iscoord(data,data!(var_rank-2))) then
+
+    if(.not.any(grid_type.eq.(/"unknown","rectilinear"/))) then
+      print("get_src_grid_info: the lat/lon values provided don't match")
+      print("               the grid type (" + grid_type + ")")
+      exit
+    end if
+
+    grid_type = "rectilinear"
+    islatlon  = True
+    lat_vals  = data&$data!(var_rank-2)$
+    lon_vals  = data&$data!(var_rank-1)$
+;---Unstructured grid?
+  else if(isatt(data,"lat1d").and.isatt(data,"lon1d")) then
+    if(.not.any(grid_type.eq.(/"unknown","unstructured"/))) then
+      print("get_src_grid_info: the lat/lon values provided don't match")
+      print("                        the grid type (" + grid_type + \
+                                      ") specified.")
+      exit
+    end if
+    
+    grid_type = "unstructured"
+    islatlon  = True
+    lat_vals  = data@lat1d
+    lon_vals  = data@lon1d
+
+;---Better be a grid like "5deg" or "2x3"!
+  else
+    islatlon  = False      ; No lat/lon values specified
+  end if
+  end if
+  end if
+  end if
+
+  if(grid_type.eq."unknown".and..not.islatlon) then
+    print("get_src_grid_info: can't determine what type of " + \
+          grid_long_string + " grid you have.")
+    exit
+  end if
+
+;---rectilinear, curvilinear, and unstructured require lat/lon values.
+  if(any(grid_type.eq.(/"rectilinear","curvilinear","unstructured"/)).and.\
+     .not.islatlon) then
+    print("get_src_grid_info: no lat/lon values provided for type of grid specified (" + grid_type + ").")
+    exit
+  end if
+
+  if(grid_type.eq."unknown".and..not.islatlon) then
+    print("get_src_grid_info: can't determine type of grid you have.")
+    exit
+  end if
+  if(islatlon) then
+    lat_dims  = dimsizes(lat_vals)
+    lon_dims  = dimsizes(lon_vals)
+    lat_rank  = dimsizes(lat_dims)
+    lon_rank  = dimsizes(lon_dims)
+    slat_dims = tostring(lat_dims)
+    slon_dims = tostring(lon_dims)
+
+    if(DEBUG) then
+      print("get_src_grid_info: " + grid_long_string + \
+            " lat dims = (" + str_join(slat_dims,",") + ")")
+      print("get_src_grid_info: " + grid_long_string + \
+            " lon dims = (" + str_join(slon_dims,",") + ")")
+    end if
+
+    if(lat_rank.gt.2.or.lon_rank.gt.2.or.lat_rank.ne.lon_rank) then
+      print("get_src_grid_info: invalid " + grid_long_string + \
+            " lat/lon given.")
+      exit
+    end if
+
+;---If grid_type still unknown at this point, try to guess at it.
+    if(grid_type.eq."unknown") then
+;---Test for rectilinear
+      if(lat_rank.eq.1.and.var_rank.gt.1.and.\
+         var_dims(var_rank-2).eq.lat_dims.and.\
+         var_dims(var_rank-1).eq.lon_dims) then
+        grid_type = "rectilinear"
+;---Test for curvilinear
+      else if(lat_rank.eq.2.and.lon_rank.eq.2.and.\
+              all(lat_dims.eq.lon_dims)) then
+        grid_type = "curvilinear"
+;
+; Test for unstructured (what a mess). The extra long test is to 
+; make sure this is not possibly a rectilinear grid.
+;
+      else if(lat_rank.eq.1.and.lon_rank.eq.1.and.lat_dims.eq.lon_dims.and.\
+              ((var_rank.eq.1.and.var_dims.eq.lat_dims).or.\
+               (var_rank.gt.1.and.var_dims(var_rank-1).eq.lat_dims.and.\
+                var_dims(var_rank-2).ne.var_dims(var_rank-1)))) then
+        grid_type = "unstructured"
+      end if
+      end if
+      end if
+    end if
+  end if
+
+;---If grid_type is still "unknown", then we can't continue.
+  if(grid_type.eq."unknown") then
+    print("get_src_grid_info: " + grid_type_name + " and/or " + \
+          grid_lat_name + "/" + grid_lon_name + " were not set.")
+    print("          Cannot determine the " + grid_long_string + \
+          " grid type.")
+    exit
+  end if
+
+  if(DEBUG) then
+    print("get_src_grid_info: " + grid_long_string + \
+           " grid type is '" + grid_type + "'")
+  end if
+
+  if(grid_type.eq."rectilinear") then
+    latlon_dims = (/lat_dims,lon_dims/)
+    left_rank   = var_rank-2
+  else if(grid_type.eq."curvilinear") then
+    latlon_dims = lat_dims
+    left_rank   = var_rank-2
+  else if(grid_type.eq."unstructured") then
+    latlon_dims = lat_dims
+    left_rank   = var_rank-1
+  else
+    return([/grid_type/])
+  end if
+  end if
+  end if
+
+  if(left_rank.ge.1)
+    left_dims = var_dims(0:left_rank-1)
+  else
+    left_dims = -1
+  end if    
+
+  return([/grid_type,latlon_dims,lat_vals,lon_vals,left_dims/])
+end
+
+;----------------------------------------------------------------------
+; Note: this routine should be combined with "get_src_grid_info" to
+; make just one "get_grid_info" routine. For now, any changes made to
+; this routine should potentially be done to "get_src_grid_info".
+;
+; Given an option variable, this function returns information about 
+; the destination grid and the lat/lon values, if appropriate.
+;
+; The lat/lon values can be provided via:
+;
+;   - DstGridLat/DstGridLon
+;
+;   - By a grid type of "5deg", "1x1", "2x3", etc.
+;----------------------------------------------------------------------
+undef("get_dst_grid_info")
+function get_dst_grid_info(opt)
+local opt2, grid_type_name, grid_lat_name, grid_lon_name, islatlon, \
+      grid_string, lat_dims, lon_dims, slat_dims, slon_dims, \
+      lat_rank, lon_rank, grid_long_string
+begin
+  opt2             = opt
+  grid_string      = "Dst"
+  grid_long_string = "destination"
+
+  DEBUG = isatt_logical_true(opt2,"Debug")
+
+;---List of some of the possible attributes attached to "opt".
+  grid_type_name = grid_string + "GridType"
+  grid_lat_name  = grid_string + "GridLat"
+  grid_lon_name  = grid_string + "GridLon"
+
+  grid_type = str_lower(get_att_value(opt2,grid_type_name,"unknown"))
+
+;---Check if DstGridLat/DstGridLon were specified.
+  if(isatt(opt2,grid_lat_name).and.isatt(opt2,grid_lon_name)) then
+    islatlon = True
+    lat_vals = opt2@$grid_lat_name$
+    lon_vals = opt2@$grid_lon_name$
+;---Better be a grid like "5deg" or "2x3"!
+  else
+    islatlon  = False      ; No lat/lon values specified
+  end if
+
+  if(grid_type.eq."unknown".and..not.islatlon) then
+    print("get_dst_grid_info: can't determine what type of " + \
+          grid_long_string + " grid you have.")
+    exit
+  end if
+
+;---rectilinear, curvilinear, and unstructured require lat/lon values.
+  if(any(grid_type.eq.(/"rectilinear","curvilinear","unstructured"/)).and.\
+     .not.islatlon) then
+    print("get_dst_grid_info: no lat/lon values provided for type of grid specified (" + grid_type + ").")
+    exit
+  end if
+
+  if(grid_type.eq."unknown".and..not.islatlon) then
+    print("get_dst_grid_info: can't determine type of grid you have.")
+    exit
+  end if
+  if(islatlon) then
+    lat_dims  = dimsizes(lat_vals)
+    lon_dims  = dimsizes(lon_vals)
+    lat_rank  = dimsizes(lat_dims)
+    lon_rank  = dimsizes(lon_dims)
+    slat_dims = tostring(lat_dims)
+    slon_dims = tostring(lon_dims)
+
+    if(DEBUG) then
+      print("get_dst_grid_info: " + grid_long_string + \
+            " lat dims = (" + str_join(slat_dims,",") + ")")
+      print("get_dst_grid_info: " + grid_long_string + \
+            " lon dims = (" + str_join(slon_dims,",") + ")")
+    end if
+
+    if(lat_rank.gt.2.or.lon_rank.gt.2.or.lat_rank.ne.lon_rank) then
+      print("get_dst_grid_info: invalid " + grid_long_string + \
+            " lat/lon given.")
+      exit
+    end if
+
+;
+; If grid_type still unknown at this point, try to guess at it.
+;
+; Note: if lat_dims and lon_dims are both 1D and equal in length,
+; this can be either an unstructured or rectilinear grid. In
+; this case, the user *must* set "grid_type" to either "rectilinear"
+; or "unstructured" so that it's clear which one this is.
+;
+    if(grid_type.eq."unknown") then
+      if(lat_rank.eq.1.and.lon_rank.eq.1.and.lat_dims.ne.lon_dims) then
+        grid_type = "rectilinear"
+      else if(lat_rank.eq.2.and.lon_rank.eq.2.and.\
+              all(lat_dims.eq.lon_dims)) then
+        grid_type = "curvilinear"
+      end if
+      end if
+    end if
+  end if
+
+;---If grid_type is still "unknown", then we can't continue.
+  if(grid_type.eq."unknown") then
+    if(lat_rank.eq.1.and.lon_rank.eq.1.and.lat_dims.eq.lon_dims) then
+      print("get_dst_grid_info: Error: the lat/lon arrays are both 1D and the same length.")
+      print("   This could be a rectilinear or unstructured grid. Please set 'grid_type'")
+      print("   to 'rectilinear' or 'unstructured'.")
+    else   
+      print("get_dst_grid_info: " + grid_type_name + " and/or " + \
+            grid_lat_name + "/" + grid_lon_name + " were not set.")
+      print("          Cannot determine the " + grid_long_string + \
+            " grid type.")
+    end if
+    exit
+  end if
+
+  if(grid_type.eq."rectilinear") then
+    latlon_dims = (/lat_dims,lon_dims/)
+  else if(grid_type.eq."curvilinear".or.grid_type.eq."unstructured") then
+    latlon_dims = lat_dims
+  end if
+  end if
+
+  if(islatlon) then
+    return([/grid_type,latlon_dims,lat_vals,lon_vals/])
+  else
+    return([/grid_type/])
+  end if
+end
+
+;======================================================================
+; This procedure is a generic one that writes the description of a 
+; source or destination grid to a NetCDF file. It distinguishes 
+; between the source and data grids via the "which_grid" option,
+; and also via the "opt" attributes which can start with "Src" or
+; "Dst".
+;
+; Arguments:
+;    srcData    - variable to be regridded
+;    which_grid - must be "Src" or "Dst" (or "source", "destination")
+;    opt        - logical variable with attributes
+;======================================================================
+undef("write_grid_description_file")
+procedure write_grid_description_file(srcData,which_grid,opt)
+local opt_new, opt2, grid_type, lat_dims, lon_dims, \
+      lat_rank, lon_rank, grid_file_name, grid_lat_name, DEBUG, \
+      grid_string, grid_lon_name, grid_type_name, spc_atts, \
+      lat_vals, lon_vals, gen_atts, tmp_att, i, grid_type
+begin
+  opt_new = True  ; For constructing new options list
+  opt2    = opt   ; Make a copy so we can modify it
+
+  DEBUG = isatt_logical_true(opt2,"Debug")
+
+;---Test which_grid
+  valid_src_names = (/"src","source"/)
+  valid_dst_names = (/"dst","destination"/)
+  if(any(str_lower(which_grid).eq.valid_src_names)) then
+    grid_string      = "Src"
+    grid_long_string = "source"
+  else if(any(str_lower(which_grid).eq.valid_dst_names)) then
+    grid_string      = "Dst"
+    grid_long_string = "destination"
+  else
+    grid_string = ""
+  end if
+  end if
+  if(grid_string.eq."") then
+    print("write_grid_description_file: don't recognize value for second " + \
+          "argument: '" + which_grid + "'")
+    exit
+  end if  
+
+;
+; Some attribute options cannot both be set if they have
+; different values.  Check for them here.
+;
+  check_both_atts(opt2,grid_string+"Overwrite","Overwrite",False)
+  check_both_atts(opt2,grid_string+"ForceOverwrite","ForceOverwrite",False)
+
+;---List of some of the possible attributes attached to "opt".
+  grid_file_name = grid_string + "FileName"
+  grid_type_name = grid_string + "GridType"
+
+;
+; Check for generic attributes to pass through; that is,
+; attributes like "Debug".
+;
+  gen_atts = (/"GridCornerDelta","PrintTimings","Overwrite","ForceOverwrite","Debug"/)
+  do i=0,dimsizes(gen_atts)-1
+    if(isatt(opt2,gen_atts(i))) then
+      opt_new@$gen_atts(i)$ = opt2@$gen_atts(i)$
+    end if
+  end do
+;
+; Check for specific attributes to pass through; that is,
+; attributes that start with "Src" or "Dst".
+;
+; If the generic form of the attribute has already been
+; set, like "opt@Overwrite", then ignore the specific
+; attribute, like "opt@SrcOverwrite".
+;
+  spc_atts = (/"Mask2D","TriangularMesh","LargeFile",\
+               "Title","LLCorner","URCorner", \
+               "Rotation","GridCornerLat","GridCornerLon",\
+               "InputFileName","Overwrite","ForceOverwrite"/)
+  do i=0,dimsizes(spc_atts)-1
+    tmp_att = grid_string + spc_atts(i)
+    if(isatt(opt2,tmp_att)) then
+      opt_new@$spc_atts(i)$ = opt2@$tmp_att$
+    end if
+  end do
+
+;
+; Error checking added in V6.1.1 to make sure user doesn't 
+; accidentally specify SrcFileName or DstFileName to be
+; the original input file names.
+;
+  if(isatt(opt2,grid_file_name).and.isfilepresent(opt2@$grid_file_name$).and.\
+     .not.is_SCRIP(opt2@$grid_file_name$,False).and.\
+     .not.is_ESMF(opt2@$grid_file_name$,False)) then
+     print("ESMF_regrid: error: the file name given for the output " + grid_long_string)
+     print("    grid file (via the special option '" + grid_string + "FileName') already exists")
+     print("    ('" + opt2@$grid_file_name$ + "'), but doesn't appear to be a SCRIP")
+     print("    file. Make sure you are not overwriting any original data files!")
+     print("")
+     print("    Remember: '" + grid_string + "FileName' should be set to the name of the")
+     print("    *output* " + grid_long_string + " grid description file that will be")
+     print("    created, and not the name of the original input file that")
+     print("    contains your data or destination grid. Use '" + grid_string + "InputFileName'")
+     print("    for that purpose.")
+     exit
+  end if
+
+  if(grid_string.eq."Src") then
+    grid_info_list = get_src_grid_info(opt2,srcData)
+  else
+    grid_info_list = get_dst_grid_info(opt2)
+  end if
+  nlist     = ListCount(grid_info_list)
+  grid_type = grid_info_list[0]
+  if(nlist.gt.1) then
+    latlon_dims = grid_info_list[1]
+    lat_vals    = grid_info_list[2]
+    lon_vals    = grid_info_list[3]
+  end if
+
+;---Check if user set a filename for the description file
+  grid_file = get_att_value(opt2,grid_file_name,grid_long_string + \
+                                               "_grid_file.nc")
+  if(grid_type.eq."rectilinear") then
+    rectilinear_to_SCRIP(grid_file,lat_vals,lon_vals,opt_new)
+  else if(grid_type.eq."curvilinear") then
+    curvilinear_to_SCRIP(grid_file,lat_vals,lon_vals,opt_new)
+  else if(grid_type.eq."unstructured") then
+    unstructured_to_ESMF(grid_file,lat_vals,lon_vals,opt_new)
+
+;---Make sure SrcESMF or DstESMF is set (the default is to assume SCRIP)
+    tmp_att = grid_string + "ESMF"
+    opt@$tmp_att$ = True
+  else
+    latlon_to_SCRIP(grid_file,grid_type,opt_new)
+    opt@$grid_type_name$ = "rectilinear"
+  end if
+  end if
+  end if
+
+;---Save the name of the description file and grid type
+  if(.not.isatt(opt,grid_file_name)) then
+    opt@$grid_file_name$ = grid_file
+  end if
+  if(.not.isatt(opt,grid_type_name)) then
+    opt@$grid_type_name$ = grid_type
+  end if
+end
+
+;======================================================================
+; This function combines all the regridding steps:
+;   1) Describing the source and destination grids
+;   2) Generating the weights
+;   3) Apply the weights to a given variable
+;
+; This function recognizes the following options
+;
+; Recognized attributes for "Opt":
+;   SrcLLCorner / SrcURCorner - defaults to (-90,-180) / ( 90, 180)
+;   DstLLCorner / DstURCorner - defaults to (-90,-180) / ( 90, 180)
+;   SrcRotation / DstRotation - rotation angle
+;
+; SrcGridCornerLat,SrcGridCornerLon / DstGridCornerLat,DstGridCornerLon
+;  - if set, then these values are used rather than calculating the 
+;    corner points for the cells 
+;
+;  SrcFileName / DstFileName
+;  SrcGridType / SrcGridLat / SrcGridLon
+;  DstGridType / DstGridLat / DstGridLon
+;  SrcMask2D / DstMask2D
+;  SrcLargeFile / DstLargeFile
+;  WgtFileName
+;  SkipSrcGrid / SkipDstGrid / SkipWgtGen
+;  Debug
+;  PrintTimings
+;  ForceOverwrite
+;  Overwrite
+;======================================================================
+undef("ESMF_regrid")
+function ESMF_regrid(srcData:numeric, opt[1]:logical)
+local opt2, src_dims, src_rank, src_grid_type, src_grid_name, \
+      src_lat_dims, src_lon_dims, src_lat_rank, src_lon_rank, \
+      dst_dims, dst_rank, dst_grid_type, dst_grid_name, \
+      dst_lat_dims, dst_lon_dims, dst_lat_rank, dst_lon_rank, \
+      dstlat, dstlon, wgt_file_name, remove_dst_file, \
+      remove_src_file, remove_wgt_file, DEBUG
+begin
+;---Check for certain options that must be set.
+  if(.not.opt) then
+    print("ESMF_regrid: opt was set to False. Can't continue.")
+    exit
+  end if
+
+  DEBUG = isatt_logical_true(opt,"Debug")
+
+;---Make a copy so we don't modify original opt.
+  opt2 = opt
+
+;---Check for incompatible attributes set by user
+  check_both_atts(opt2,"RemoveFiles","RemoveSrcFile",False)
+  check_both_atts(opt2,"RemoveFiles","RemoveDstFile",False)
+  check_both_atts(opt2,"RemoveFiles","RemoveWgtFile",False)
+
+;
+; Check if any of the source, grid, or weight files are
+; to be removed after this function is done. It's easier
+; to let this routine handle it, than ESMF_regrid_gen_weights,
+; so just do it.
+;
+  remove_src_file = False
+  remove_dst_file = False
+  remove_wgt_file = False
+  if(isatt_logical_true(opt2,"RemoveFiles")) then
+    delete(opt2@RemoveFiles)
+    remove_src_file = True
+    remove_dst_file = True
+    remove_wgt_file = True
+  end if
+  if(isatt_logical_true(opt2,"RemoveSrcFile")) then
+    delete(opt2@RemoveSrcFile)
+    remove_src_file = True
+  end if
+  if(isatt_logical_true(opt2,"RemoveDstFile")) then
+    delete(opt2@RemoveDstFile)
+    remove_dst_file = True
+  end if
+  if(isatt_logical_true(opt2,"RemoveWgtFile")) then
+    delete(opt2@RemoveWgtFile)
+    remove_wgt_file = True
+  end if
+
+;---Write source grid description file
+  if(.not.isatt_logical_true(opt2,"SkipSrcGrid")) then
+    write_grid_description_file(srcData,"Src",opt2)
+  else
+    if(DEBUG) then
+      print("ESMF_regrid: skipping generation of source grid.")
+    end if
+  end if
+    
+;---Write destination grid description file
+  if(.not.isatt_logical_true(opt2,"SkipDstGrid")) then
+    write_grid_description_file(srcData,"Dst",opt2)
+  else
+    if(DEBUG) then
+      print("ESMF_regrid: skipping generation of destination grid.")
+      print("             You may need to set DstGridType.")
+    end if
+  end if
+
+;--------------------------------------------------
+; Section to generate the weights
+;--------------------------------------------------
+  wgt_file_name         = get_att_value(opt2,"WgtFileName","weights_file.nc")
+  if(.not.isatt_logical_true(opt2,"SkipWgtGen")) then
+;
+; If skipped the source and/or destination grid generation phase, then
+; the user must supply the names of the grid files explicitly.
+;
+    if(isatt_logical_true(opt,"SkipSrcGrid").and.isatt(opt,"SrcFileName")) then
+      src_grid_file = opt@SrcFileName
+    else if(.not.isatt_logical_true(opt,"SkipSrcGrid").and.isatt(opt2,"SrcFileName")) then
+      src_grid_file = opt2@SrcFileName
+    else
+      print("ESMF_regrid: need the name of the source grid file (SrcFileName)")
+      exit
+    end if
+    end if
+    if(isatt_logical_true(opt,"SkipDstGrid").and.isatt(opt,"DstFileName")) then
+      dst_grid_file = opt@DstFileName
+    else if(.not.isatt_logical_true(opt,"SkipDstGrid").and.isatt(opt2,"DstFileName")) then
+      dst_grid_file = opt2@DstFileName
+    else
+      print("ESMF_regrid: need the name of the destination grid file (DstFileName)")
+      exit
+    end if
+    end if
+    ESMF_regrid_gen_weights(src_grid_file, dst_grid_file, wgt_file_name, opt2)
+  else
+    if(DEBUG) then
+      print("ESMF_regrid: skipping generation of weights file.")
+    end if
+  end if
+
+;
+; If patch method used, "sneak" this knowledge into the weights gen
+; routine so that we can get the correct "map_method" for the
+; "remap" attribute.
+;
+  if(opt2.and.isatt(opt2,"InterpMethod").and. \
+     str_lower(opt2@InterpMethod).eq."patch") then
+   opt2@FixMapMethodForPatch = True
+  end if
+
+;---Regrid the input variable
+  srcData_regrid = ESMF_regrid_with_weights(srcData,wgt_file_name,opt2)
+
+;---Copy variable attributes and coordinate arrays if requested.
+  ESMF_copy_varmeta(srcData,srcData_regrid,wgt_file_name,opt2)
+
+;---Clean up, if desired
+  if (remove_src_file) then
+    if(DEBUG) then
+      print("ESMF_regrid: By request, removing '" + src_grid_file + "'")
+    end if    
+    system("rm -rf " + src_grid_file)
+  end if
+
+  if (remove_dst_file) then
+    if(DEBUG) then
+      print("ESMF_regrid: By request, removing '" + dst_grid_file + "'")
+    end if    
+    system("rm -rf " + dst_grid_file)
+  end if
+
+  if (remove_wgt_file) then
+    if(DEBUG) then
+      print("ESMF_regrid: By request, removing '" + wgt_file_name + "'")
+    end if    
+    system("rm -rf " + wgt_file_name)
+  end if
+
+  return(srcData_regrid)
+end
+
+;======================================================================
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.  I'm not sure it was
+; ever used...
+;======================================================================
+undef("retrieve_dstGrid_lat")
+function retrieve_dstGrid_lat(fileName[1]:string)
+local fid, dst_grid_dims
+begin
+    if (.not.isfilepresent(fileName)) then
+        print("retrieve_dstGrid_lat: cannot open '" + fileName + "'.")
+        exit
+    end if
+
+    fid           = addfile(fileName,"r")
+    dst_grid_dims = fid->dst_grid_dims
+    lat           = reshape( fid->yc_b , dst_grid_dims(::-1))
+    return(lat)
+end     ; of retrieve_dstGrid_lat
+
+;======================================================================
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.  I'm not sure it was
+; ever used...
+;======================================================================
+undef("retrieve_dstGrid_lon")
+function retrieve_dstGrid_lon(fileName[1]:string)
+local fid, dst_grid_dims
+begin
+    if (.not.isfilepresent(fileName)) then
+        print("retrieve_dstGrid_lon: cannot open '" + fileName + "'.")
+        exit
+    end if
+
+    fid           = addfile(fileName,"r")
+    dst_grid_dims = fid->dst_grid_dims
+    lon           = reshape( fid->xc_b , dst_grid_dims(::-1))
+    return(lon)
+    
+end     ; of retrieve_dstGrid_lon
+
+;======================================================================
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.  I'm not sure it was
+; ever used...
+;======================================================================
+undef("retrieve_srcGrid_lat")
+function retrieve_srcGrid_lat(fileName[1]:string)
+local fid, src_grid_dims
+begin
+    if (.not.isfilepresent(fileName)) then
+        print("retrieve_srcGrid_lat: cannot open '" + fileName + "'.")
+        exit
+    end if
+
+    fid           = addfile(fileName,"r")
+    src_grid_dims = fid->src_grid_dims
+    lat           = reshape( fid->yc_a , src_grid_dims(::-1))
+    return(lat)
+end     ; of retrieve_srcGrid_lat
+
+;======================================================================
+; This routine is obsolete in V6.1.0 (not in V6.1.0-beta). It's
+; replaced by ESMF_copy_varcoords.  I'm not sure it was
+; ever used...
+;======================================================================
+undef("retrieve_srcGrid_lon")
+function retrieve_srcGrid_lon(fileName[1]:string)
+local fid, src_grid_dims
+begin
+    if (.not.isfilepresent(fileName)) then
+        print("retrieve_srcGrid_lon: cannot open '" + fileName + "'.")
+        exit
+    end if
+
+    fid           = addfile(fileName,"r")
+    src_grid_dims = fid->src_grid_dims
+    lon           = reshape( fid->xc_a , src_grid_dims(::-1))
+    return(lon)
+end     ; of retrieve_srcGrid_lon
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_curv_one_step.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_curv_one_step.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_curv_one_step.ncl	(revision 4775)
@@ -0,0 +1,435 @@
+;--------------------------------------------
+;---- Predefined ESMF modules
+;--------------------------------------------
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl"
+
+begin
+
+;--------------------------------------------
+;--- PATHS
+;--------------------------------------------
+  RUNDIR="wkdir_esmf_"+str_lower(srcgrid)+"_"+str_lower(tgtgrid)+"_"+str_lower(interp_method)
+  PATH1="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/"
+  PATH2="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/" 
+  PATH1="./"
+  PATH2="./"
+
+;--------------------------------------------
+;--- Source and Target grid Files used with oasis3-mct for SCRIP
+;--------------------------------------------
+  gridsfile = PATH1+"grids.nc"    ; File with grids at OASIS3-MCT description
+  masksfile = PATH1+"masks.nc"    ; File with masks at OASIS3-MCT description
+
+;--------------------------------------------
+;--- Files 
+;--------------------------------------------  
+  funcini     = PATH2+"fldin.nc"     ; File with the initial field
+  funcinterp  = PATH2+"fldou.nc"     ; File with the remapping field, error
+  srcGridName = PATH2+"source_grid_esmf.nc"
+  tgtGridName = PATH2+"target_grid_esmf.nc" 
+  wgtFile     = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + "_withfillValue.nc"
+  wgtFile1    = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_neareststod.nc"
+  wgtFilennei = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+  oa3wgtFile  = PATH2+"rmp_esmf_for_oa3mct_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+
+;--------------------------------------------
+;--- Constants
+;-------------------------------------------- 
+  msk_field_value = -1
+  msk_err_value = -10000
+  weight_fill_val = -50000
+  pi = 3.14159265359
+  dp_length = 1.2*pi
+  dp_conv   = pi/180.
+
+;--------------------------------------------
+;--- Cleaning: remove any pre-existing file
+;-------------------------------------------- 
+  system("/bin/rm -f "+funcini)
+  system("/bin/rm -f "+funcinterp)
+  system("/bin/rm -f "+srcGridName)
+  system("/bin/rm -f "+tgtGridName)
+  system("/bin/rm -f "+wgtFile)  
+  system("/bin/rm -f "+wgtFile1)  
+  system("/bin/rm -f "+wgtFilennei) 
+  system("/bin/rm -f "+oa3wgtFile)
+  system("/bin/rm -f PET0.RegridWeightGen.Log")
+
+;--------------------------------------------
+;--- Coordinate names
+;--------------------------------------------
+  srcgrdlon = srcgrid+"_lon"
+  srcgrdlat = srcgrid+"_lat"
+  srcgrdclo = srcgrid+"_clo"
+  srcgrdcla = srcgrid+"_cla"
+  srcgrdmsk = srcgrid+"_msk"
+  tgtgrdlon = tgtgrid+"_lon"
+  tgtgrdlat = tgtgrid+"_lat"
+  tgtgrdclo = tgtgrid+"_clo"
+  tgtgrdcla = tgtgrid+"_cla"
+  tgtgrdmsk = tgtgrid+"_msk"
+
+;--------------------------------------------
+;--- Read grids, masks, areas arrays
+;--------------------------------------------
+  gfile   = addfile(gridsfile,"r")
+  mfile   = addfile(masksfile,"r")
+  
+  src_lon  = gfile->$srcgrdlon$
+  src_lat  = gfile->$srcgrdlat$
+  src_msk  = mfile->$srcgrdmsk$
+  tgt_lon  = gfile->$tgtgrdlon$
+  tgt_lat  = gfile->$tgtgrdlat$
+  tgt_msk  = mfile->$tgtgrdmsk$
+
+  nlatsrc=dimsizes(src_lat(:,0))
+  nlonsrc=dimsizes(src_lon(0,:))
+  nlattgt=dimsizes(tgt_lat(:,0))
+  nlontgt=dimsizes(tgt_lon(0,:))
+
+;--------------------------------------------
+;--- Calculate the function to regrid
+;--------------------------------------------
+  func_ana_src = 2. - cos(pi*(acos(cos(src_lat*dp_conv)*cos(src_lon*dp_conv))/dp_length))
+
+;--------------------------------------------
+;--- Calculate the function on the destination grid for the error
+;--------------------------------------------
+  func_ana_tgt = 2. - cos(pi*(acos(cos(tgt_lat*dp_conv)*cos(tgt_lon*dp_conv))/dp_length))
+
+;----------------------------------------------------------------------
+;--- Regridding all in one step
+;----------------------------------------------------------------------
+  Opt                = True
+  Opt@SrcGridName    = srcGridName 
+  Opt@DstGridName    = tgtGridName
+  Opt@SrcGridLat     = src_lat
+  Opt@SrcGridLon     = src_lon
+  Opt@SrcMask2D      = 1-src_msk
+  Opt@DstGridName    = tgtGridName
+  Opt@DstGridLat     = tgt_lat
+  Opt@DstGridLon     = tgt_lon
+  Opt@DstMask2D      = 1-tgt_msk
+
+  Opt@InterpMethod   = str_lower(interp_method)
+  Opt@WgtFileName    = wgtFile
+;  Opt@Pole           = "none"
+
+  if ( interp_method .eq. str_lower("conserve") ) then
+    dims = getfilevardims(gfile,srcgrdcla)
+;---Make sure grid is nlat x nlon x 4
+    Opt@SrcGridCornerLat  = gfile->$srcgrdcla$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)     
+    Opt@SrcGridCornerLon  = gfile->$srcgrdclo$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)
+    printMinMax(Opt@SrcGridCornerLat,0)
+    printMinMax(Opt@SrcGridCornerLon,0)
+  end if	 
+
+  if ( interp_method .eq. str_lower("conserve") ) then
+    dims = getfilevardims(gfile,tgtgrdcla)
+;---Make sure grid is nlat x nlon x 4
+    Opt@DstGridCornerLat  = gfile->$tgtgrdcla$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)
+    Opt@DstGridCornerLon  = gfile->$tgtgrdclo$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)
+    printMinMax(Opt@DstGridCornerLat,0)
+    printMinMax(Opt@DstGridCornerLon,0)
+  end if	 
+
+  Opt@ForceOverwrite = True
+  Opt@PrintTimings   = True
+  Opt@Debug          = True
+
+;---You can choose to skip any of these three steps.
+; Opt@SkipSrcGrid   = True    ; Will assume source grid file has been generated
+; Opt@SkipDstGrid   = True    ; Will assume target grid file has been generated
+; Opt@SkipWgtGen    = True    ; Will assume weights file has been generated
+  
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  func_regrid = ESMF_regrid(func_ana_src,Opt)
+  printVarSummary(func_regrid)
+  undef_val=func_regrid@_FillValue
+  printVarSummary(undef_val)
+  delete (Opt)
+  func_regrid_msk_fillvalue  = where((1-tgt_msk) .eq. 1, func_regrid, msk_field_value)
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+;--------------------------------------------------------------------------
+;   Do the regridding "neareststod" all in one step to fill blank points
+;--------------------------------------------------------------------------
+  Opt=True
+  Opt@SrcGridName    = srcGridName 
+  Opt@DstGridName    = tgtGridName
+  Opt@WgtFileName    = wgtFile1
+  Opt@SrcGridLat     = src_lat
+  Opt@SrcGridLon     = src_lon
+  Opt@DstGridLat     = tgt_lat
+  Opt@DstGridLon     = tgt_lon
+  Opt@DstMask2D      = 1-tgt_msk
+  Opt@SrcMask2D      = 1-src_msk
+
+  Opt@InterpMethod   = "neareststod"
+;  Opt@Pole           = "none"
+  Opt@ForceOverwrite = True
+  Opt@PrintTimings   = True
+  Opt@Debug          = True
+
+;---You can choose to skip any of these three steps.
+;  Opt@SkipSrcGrid   = True    ; Will assume source grid file has been generated
+;  Opt@SkipDstGrid   = True    ; Will assume target grid file has been generated
+;  Opt@SkipWgtGen    = True    ; Will assume weights file has been generated
+
+  func_neareststod = ESMF_regrid(func_ana_src,Opt)
+  func_neareststod = where((1-tgt_msk) .eq. 1, func_neareststod, msk_field_value)
+
+;----------------------------------------------------------------------
+;--- Combine interp_method + neareststod
+;----------------------------------------------------------------------
+  wfile          = addfile(wgtFile,"r")  
+;
+  S_regrid       = wfile->$"S"$
+  dst_lat_w      = wfile->$"yc_b"$
+  dst_lon_w      = wfile->$"xc_b"$
+  src_lat_w      = wfile->$"yc_a"$
+  src_lon_w      = wfile->$"xc_a"$
+  dst_address    = wfile->$"row"$
+  src_address    = wfile->$"col"$
+  frac_dst       = wfile->$"frac_b"$
+  numlinks      = dimsizes(S_regrid)
+  dst_size      = dimsizes(dst_lat_w)
+  src_size      = dimsizes(src_lat_w)
+  print("dst_size_w")
+  print(dst_size)
+;
+  wfile1            = addfile(wgtFile1,"r")
+  S_neareststod     = wfile1->$"S"$
+  dst_lat_n         = wfile1->$"yc_b"$
+  dst_lon_n         = wfile1->$"xc_b"$
+  src_lat_n         = wfile1->$"yc_a"$
+  dst_neareststod   = wfile1->$"row"$
+  src_neareststod   = wfile1->$"col"$
+  links_neareststod = dimsizes(S_neareststod)
+  dst_size_n    = dimsizes(dst_lat_n)
+  print("dst_size_n")
+  print(dst_size_n)
+;
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+      func_oned                = ndtooned(func_regrid_msk_fillvalue)
+      dst_missing              = new((/dst_size/),"integer")
+      dst_missing@_FillValue   = doubletointeger(undef_val)
+
+      count = -1
+      do i=0,dst_size-1
+         if (ismissing(func_oned(i))) then
+            count = count+1
+            dst_missing(count) = i+1
+         end if
+      end do
+; count > 0 : there are some points that need nearest neighbours
+      if (count .ge. 0) then
+      dst_missing_good    = new((/count+1/),"integer")
+      do i=0,count
+         dst_missing_good(i) = dst_missing(i)
+      end do
+      delete(dst_missing)
+      print("count")
+      print(count)
+      print("dst_missing_good")
+;      print(dst_missing_good)
+;
+;--- Replace weights where function = _FillValue by 1. (neareststod)
+      dst_address_new    = new((/numlinks+count+1/),"integer")
+      src_address_new    = new((/numlinks+count+1/),"integer")
+      S_regrid_new       = new((/numlinks+count+1/),double)
+      print("New size numlinks+count")
+      print(numlinks+count+1)
+      dst_address_new(0:numlinks-1)  = dst_address
+      src_address_new(0:numlinks-1)  = src_address
+      S_regrid_new(0:numlinks-1)     = S_regrid
+      do j=0,count
+         do i=0,links_neareststod-1
+            if ( dst_neareststod(i) .eq. dst_missing_good(j) ) then
+                dst_address_new(numlinks+j) = dst_missing_good(j)
+                src_address_new(numlinks+j) = src_neareststod(i)
+                S_regrid_new(numlinks+j)    = S_neareststod(i)
+                break
+            end if
+         end do
+     end do
+     delete(dst_missing_good)
+; count = 0
+     else
+     dst_address_new    = new((/numlinks/),"integer")
+     src_address_new    = new((/numlinks/),"integer")
+     S_regrid_new       = new((/numlinks/),double)
+     dst_address_new    = dst_address
+     src_address_new    = src_address
+     S_regrid_new       = S_regrid
+     end if
+
+     delete(S_regrid)
+     delete(dst_address)
+     delete(src_address)
+
+     igood = ind (.not. ismissing(S_regrid_new))
+     S_regrid = S_regrid_new(igood)
+     src_address = src_address_new(igood)
+     dst_address = dst_address_new(igood)
+
+; endif neareststod
+     delete(S_regrid_new)
+     delete(dst_address_new)
+     delete(src_address_new)
+     end if
+
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Recalculate the interpolated function with the new weights with ESMF
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  if (interp_method .eq. "neareststod") then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+  filennei = addfile(wgtFilennei,"c")
+  globalAtt               = True
+  globalAtt@title         = "ESMF Offline Regridding Weight Generator"
+  globalAtt@normalization = "destarea"
+  if (interp_method .eq. str_lower("conserve")) then
+     globalAtt@map_method = "Conservative remapping"
+     globalAtt@ESMF_regrid_method = "First-order Conservative"
+  end if
+  if (interp_method .eq. str_lower("bilinear")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Bilinear"
+  end if
+  if (interp_method .eq. str_lower("patch")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Higher-order Patch"
+  end if
+  if (interp_method .eq. str_lower("neareststod")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Nearest source to destination"
+  end if
+  globalAtt@conventions   = "NCAR-CSM"
+  globalAtt@domain_a      = "source_grid_file.nc"
+  globalAtt@domain_b      = "destination_grid_file.nc"
+  globalAtt@grid_file_src = "source_grid_file.nc"
+  globalAtt@grid_file_dst = "destination_grid_file.nc"
+  globalAtt@CVS_revision  = "6.3.0r"
+;
+  fileattdef( filennei, globalAtt )
+  vars = getfilevarnames (wfile)
+  nv=dimsizes(vars)
+  print(nv)
+  S_nnei=S_regrid
+  num_links= dimsizes(S_regrid)
+  var_temp=new((/1/),integer)
+  var_temp(0)=1
+  src_address!0="n_s"
+  dst_address!0="n_s"
+  S_nnei!0="n_s"
+  var_temp!0="num_wgts"
+  delete(src_address@_FillValue)
+  delete(dst_address@_FillValue)
+  delete(S_nnei@_FillValue)
+  do i = 0,nv-4
+     filennei->$vars(i)$=wfile->$vars(i)$
+  end do
+  filennei->$"col"$=src_address
+  filennei->$"row"$=dst_address
+  filennei->$"S"$=S_nnei
+  filennei->$"var_temp"$=var_temp
+
+  Opt                = True
+  Opt@Debug          = True
+  Opt@PrintTimings   = True
+  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFilennei,Opt)
+;  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFile,Opt)
+  printVarSummary(func_regrid_new)
+
+  func_regrid_msk_new  = where((1-tgt_msk) .eq. 1, func_regrid_new, msk_field_value)
+
+  delete(var_temp)
+  end if
+;--------------------------------------------
+;--- Calculate the error on the target grid
+;--------------------------------------------
+  func_ana_tgt       = where((1-tgt_msk) .eq. 1, func_ana_tgt, msk_field_value)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_new)/func_regrid_msk_new))*100, msk_err_value)
+  else
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_fillvalue)/func_regrid_msk_fillvalue))*100, msk_err_value)
+  end if
+  print("Max of the error (equal -10000 on land)")
+  printMinMax(error,True)
+  error_min = where(error .eq. msk_err_value, - msk_err_value, error)
+  print("Min of the error (equal 10000 on land)")
+  printMinMax(error_min,True)
+
+;--------------------------------------------
+;--- Output files: to plot ESMF results and create the rmp file for OASIS3-MCT
+;--------------------------------------------
+  ifile = addfile(funcini,"c")
+  ifile->$srcgrdlon$=src_lon
+  ifile->$srcgrdlat$=src_lat
+  ifile->$"field_in"$=(func_ana_src)
+
+  ofile = addfile(funcinterp,"c")
+  ofile->$tgtgrdlon$=tgt_lon
+  ofile->$tgtgrdlat$=tgt_lat
+  ofile->$"field_ana"$=(func_ana_tgt)
+  ofile->$"field_undef"$=(func_regrid)
+  ofile->$"field_msk_undef"$=(func_regrid_msk_fillvalue)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+     ofile->$"field_ou"$=(func_regrid_msk_new)
+  end if
+  ofile->$"error"$=(error)
+
+;---- Write the rmp file for OASIS3-MCT
+; if bilinear interpolation : num_wgts=1
+; if conservative interpolation : num_wgts=3
+; if nearest neighbour : num_wgts=1
+
+;--- Normalize to obtain Fracarea option for OASIS3-MCT for conservative interpolation
+  if (interp_method .eq. str_lower("conserve")) then
+     do i=0,num_links-1
+        if (frac_dst(dst_address(i)-1) .ne. 0.0) then
+           S_regrid(i)=S_regrid(i)/frac_dst(dst_address(i)-1)
+        end if
+     end do
+  end if
+
+    oa3file = addfile(oa3wgtFile,"c")
+    dst_lat_w!0="dst_grid_size"
+    src_lat_w!0="src_grid_size"
+    src_address!0="num_links"
+    dst_address!0="num_links"
+    oa3file->$"src_grid_center_lat"$=src_lat_w 
+    oa3file->$"dst_grid_center_lat"$=dst_lat_w 
+    oa3file->$"src_address"$=src_address
+    oa3file->$"dst_address"$=dst_address
+    if (interp_method .eq. "conserve") then
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=3
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp
+       var(:,1) = 0. 
+       var(:,2) = 0. 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  else
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=1
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  end if
+
+end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_unstructured_one_step.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_unstructured_one_step.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_curv_to_unstructured_one_step.ncl	(revision 4775)
@@ -0,0 +1,449 @@
+;----------------------------------------------------------------------
+; This script regrids dummy data from a curvilinear grid to an
+; unstructured grid. Both grids are on one NetCDF file.
+;
+; There's an issue with this script if you try to apply SrcMask2D,
+; because it causes the destination grid to be reduced in the number
+; of points (24,572 to 24,067). The fix seems to be in not setting
+; SrcMask2D, but I would like to figure out why this is the case.
+;----------------------------------------------------------------------
+;--------------------------------------------
+;---- Predefined ESMF modules
+;--------------------------------------------
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+;
+; Loading a personal ESMF regridding script to provide
+; a needed bug fix for curvilinear to unstructured.
+;
+;load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl"
+load "./ESMF_regridding.ncl"
+
+begin
+;--------------------------------------------
+;--- PATHS
+;--------------------------------------------
+  RUNDIR="wkdir_esmf_"+str_lower(srcgrid)+"_"+str_lower(tgtgrid)+"_"+str_lower(interp_method)
+  PATH1="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/"
+  PATH2="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/" 
+  PATH1="./"
+  PATH2="./"
+
+; WARNING : DOES NOT WORK YET FOR CONSERVATIVE REMAPPING
+  if (str_lower(interp_method) .eq. str_lower("conserve")) then
+     print("Does not work yet for conservative remapping")
+     exit
+  end if 
+;--------------------------------------------
+;--- Source and Target grid Files used with oasis3-mct for SCRIP
+;--------------------------------------------
+  gridsfile = PATH1+"grids.nc"    ; File with grids at OASIS3-MCT description
+  masksfile = PATH1+"masks.nc"    ; File with masks at OASIS3-MCT description
+
+;--------------------------------------------
+;--- Files 
+;--------------------------------------------  
+  funcini     = PATH2+"fldin.nc"     ; File with the initial field
+  funcinterp  = PATH2+"fldou.nc"     ; File with the remapping field, error
+  srcGridName = PATH2+"source_grid_esmf.nc"
+  tgtGridName = PATH2+"target_grid_esmf.nc" 
+  wgtFile     = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + "_withfillValue.nc"
+  wgtFile1    = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_neareststod.nc"
+  wgtFilennei = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+  oa3wgtFile  = PATH2+"rmp_esmf_for_oa3mct_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+
+;--------------------------------------------
+;--- Constants
+;-------------------------------------------- 
+  msk_field_value = -1
+  msk_err_value = -10000
+  weight_fill_val = -50000
+  pi = 3.14159265359
+  dp_length = 1.2*pi
+  dp_conv   = pi/180.
+
+;--------------------------------------------
+;--- Cleaning: remove any pre-existing file
+;-------------------------------------------- 
+  system("/bin/rm -f "+funcini)
+  system("/bin/rm -f "+funcinterp)
+  system("/bin/rm -f "+srcGridName)
+  system("/bin/rm -f "+tgtGridName)
+  system("/bin/rm -f "+wgtFile)  
+  system("/bin/rm -f "+wgtFile1)  
+  system("/bin/rm -f "+wgtFilennei) 
+  system("/bin/rm -f "+oa3wgtFile)
+  system("/bin/rm -f PET0.RegridWeightGen.Log")
+
+;--------------------------------------------
+;--- Coordinate names
+;--------------------------------------------
+  srcgrdlon = srcgrid+"_lon"
+  srcgrdlat = srcgrid+"_lat"
+  srcgrdclo = srcgrid+"_clo"
+  srcgrdcla = srcgrid+"_cla"
+  srcgrdmsk = srcgrid+"_msk"
+  tgtgrdlon = tgtgrid+"_lon"
+  tgtgrdlat = tgtgrid+"_lat"
+  tgtgrdclo = tgtgrid+"_clo"
+  tgtgrdcla = tgtgrid+"_cla"
+  tgtgrdmsk = tgtgrid+"_msk"
+
+;--------------------------------------------
+;--- Read grids, masks, areas arrays
+;--------------------------------------------
+  gfile   = addfile(gridsfile,"r")
+  mfile   = addfile(masksfile,"r")
+  
+  nt=0
+  src_lon  = gfile->$srcgrdlon$
+  src_lat  = gfile->$srcgrdlat$
+  src_clo  = gfile->$srcgrdclo$
+  src_cla  = gfile->$srcgrdcla$
+  src_msk  = mfile->$srcgrdmsk$
+  tgt_lon  = gfile->$tgtgrdlon$(nt,:)
+  tgt_lat  = gfile->$tgtgrdlat$(nt,:)
+  tgt_clo  = gfile->$tgtgrdclo$(:,nt,:)
+  tgt_cla  = gfile->$tgtgrdcla$(:,nt,:)
+  tgt_msk  = mfile->$tgtgrdmsk$(nt,:)
+
+  nlatsrc=dimsizes(src_lat(:,0))
+  nlonsrc=dimsizes(src_lon(0,:))
+  nlattgt=dimsizes(tgt_lat)
+  nlontgt=dimsizes(tgt_lon)
+
+;--------------------------------------------
+;--- Calculate the function to regrid
+;--------------------------------------------
+  func_ana_src = 2. - cos(pi*(acos(cos(src_lat*dp_conv)*cos(src_lon*dp_conv))/dp_length))
+
+;--------------------------------------------
+;--- Calculate the function on the destination grid for the error
+;--------------------------------------------
+  func_ana_tgt = 2. - cos(pi*(acos(cos(tgt_lat*dp_conv)*cos(tgt_lon*dp_conv))/dp_length))
+
+;----------------------------------------------------------------------
+;--- Regridding all in one step
+;----------------------------------------------------------------------
+  Opt                   = True
+  Opt@SrcGridName       = srcGridName 
+  Opt@SrcGridLat        = src_lat
+  Opt@SrcGridLon        = src_lon
+  Opt@SrcMask2D         = 1-src_msk     ; Don't set this, otherwise you may get error.
+  Opt@DstGridName       = tgtGridName
+  Opt@DstGridLat        = tgt_lat
+  Opt@DstGridLon        = tgt_lon   
+  Opt@DstMask2D         = 1-tgt_msk
+  Opt@DstGridType       = "unstructured"
+
+  Opt@InterpMethod      = str_lower(interp_method)
+  Opt@WgtFileName       = wgtFile
+
+  if ( interp_method .eq. str_lower("conserve") ) then
+    dims = getfilevardims(gfile,srcgrdcla)
+;---Make sure grid is nlat x nlon x 4
+    Opt@SrcGridCornerLat  = gfile->$srcgrdcla$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)     
+    Opt@SrcGridCornerLon  = gfile->$srcgrdclo$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)
+    printMinMax(Opt@SrcGridCornerLat,0)
+    printMinMax(Opt@SrcGridCornerLon,0)
+  end if
+
+  if(Opt@InterpMethod.eq.str_lower("conserve")) then
+    Opt@DstGridCornerLat  = ndtooned(tgt_cla)
+    Opt@DstGridCornerLon  = ndtooned(tgt_clo)
+  end if
+
+  Opt@ForceOverwrite    = True
+  Opt@PrintTimings      = True
+  Opt@Debug             = True
+;
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  func_regrid = ESMF_regrid(func_ana_src,Opt)
+  printVarSummary(func_regrid)
+  undef_val=func_regrid@_FillValue
+  printVarSummary(undef_val)
+  delete (Opt)
+  func_regrid_msk_fillvalue  = where((1-tgt_msk) .eq. 1, func_regrid, msk_field_value)
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+;--------------------------------------------------------------------------
+;   Do the regridding "neareststod" all in one step to fill blank points
+;--------------------------------------------------------------------------
+  Opt=True
+  Opt@SrcGridName    = srcGridName 
+  Opt@DstGridName    = tgtGridName
+  Opt@WgtFileName    = wgtFile1
+  Opt@SrcGridLat     = src_lat
+  Opt@SrcGridLon     = src_lon
+  Opt@DstGridLat     = tgt_lat
+  Opt@DstGridLon     = tgt_lon
+  Opt@DstMask2D      = 1-tgt_msk
+  Opt@SrcMask2D      = 1-src_msk
+
+  Opt@DstGridType       = "unstructured"
+
+  Opt@InterpMethod   = "neareststod"
+;  Opt@Pole           = "none"
+  Opt@ForceOverwrite = True
+  Opt@PrintTimings   = True
+  Opt@Debug          = True
+
+;---You can choose to skip any of these three steps.
+;  Opt@SkipSrcGrid   = True    ; Will assume source grid file has been generated
+;  Opt@SkipDstGrid   = True    ; Will assume target grid file has been generated
+;  Opt@SkipWgtGen    = True    ; Will assume weights file has been generated
+
+  func_neareststod = ESMF_regrid(func_ana_src,Opt)
+  func_neareststod = where((1-tgt_msk) .eq. 1, func_neareststod, msk_field_value)
+;----------------------------------------------------------------------
+;--- Combine interp_method + neareststod
+;----------------------------------------------------------------------
+  wfile          = addfile(wgtFile,"r")  
+;
+  S_regrid       = wfile->$"S"$
+  dst_lat_w      = wfile->$"yc_b"$
+  dst_lon_w      = wfile->$"xc_b"$
+  src_lat_w      = wfile->$"yc_a"$
+  src_lon_w      = wfile->$"xc_a"$
+  dst_address    = wfile->$"row"$
+  src_address    = wfile->$"col"$
+  frac_dst       = wfile->$"frac_b"$
+  numlinks      = dimsizes(S_regrid)
+  dst_size      = dimsizes(dst_lat_w)
+  src_size      = dimsizes(src_lat_w)
+  print("dst_size_w")
+  print(dst_size)
+;
+  wfile1            = addfile(wgtFile1,"r")
+  S_neareststod     = wfile1->$"S"$
+  dst_lat_n         = wfile1->$"yc_b"$
+  dst_lon_n         = wfile1->$"xc_b"$
+  src_lat_n         = wfile1->$"yc_a"$
+  dst_neareststod   = wfile1->$"row"$
+  src_neareststod   = wfile1->$"col"$
+  links_neareststod = dimsizes(S_neareststod)
+  dst_size_n    = dimsizes(dst_lat_n)
+  print("dst_size_n")
+  print(dst_size_n)
+;
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+      func_oned                = ndtooned(func_regrid_msk_fillvalue)
+      dst_missing              = new((/dst_size/),"integer")
+      dst_missing@_FillValue   = doubletointeger(undef_val)
+
+      count = -1
+      do i=0,dst_size-1
+         if (ismissing(func_oned(i))) then
+            count = count+1
+            dst_missing(count) = i+1
+         end if
+      end do
+; count > 0 : there are some points that need nearest neighbours
+      if (count .ge. 0) then
+      dst_missing_good    = new((/count+1/),"integer")
+      do i=0,count
+         dst_missing_good(i) = dst_missing(i)
+      end do
+      delete(dst_missing)
+      print("count")
+      print(count)
+      print("dst_missing_good")
+;      print(dst_missing_good)
+;
+;--- Replace weights where function = _FillValue by 1. (neareststod)
+      dst_address_new    = new((/numlinks+count+1/),"integer")
+      src_address_new    = new((/numlinks+count+1/),"integer")
+      S_regrid_new       = new((/numlinks+count+1/),double)
+      print("New size numlinks+count")
+      print(numlinks+count+1)
+      dst_address_new(0:numlinks-1)  = dst_address
+      src_address_new(0:numlinks-1)  = src_address
+      S_regrid_new(0:numlinks-1)     = S_regrid
+      do j=0,count
+         do i=0,links_neareststod-1
+            if ( dst_neareststod(i) .eq. dst_missing_good(j) ) then
+                dst_address_new(numlinks+j) = dst_missing_good(j)
+                src_address_new(numlinks+j) = src_neareststod(i)
+                S_regrid_new(numlinks+j)    = S_neareststod(i)
+                break
+            end if
+         end do
+     end do
+     delete(dst_missing_good)
+; count = 0
+     else
+     dst_address_new    = new((/numlinks/),"integer")
+     src_address_new    = new((/numlinks/),"integer")
+     S_regrid_new       = new((/numlinks/),double)
+     dst_address_new    = dst_address
+     src_address_new    = src_address
+     S_regrid_new       = S_regrid
+     end if
+
+     delete(S_regrid)
+     delete(dst_address)
+     delete(src_address)
+
+     igood = ind (.not. ismissing(S_regrid_new))
+     S_regrid = S_regrid_new(igood)
+     src_address = src_address_new(igood)
+     dst_address = dst_address_new(igood)
+
+; endif neareststod
+     delete(S_regrid_new)
+     delete(dst_address_new)
+     delete(src_address_new)
+     end if
+
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Recalculate the interpolated function with the new weights with ESMF
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+  filennei = addfile(wgtFilennei,"c")
+  globalAtt               = True
+  globalAtt@title         = "ESMF Offline Regridding Weight Generator"
+  globalAtt@normalization = "destarea"
+  if (interp_method .eq. str_lower("conserve")) then
+     globalAtt@map_method = "Conservative remapping"
+     globalAtt@ESMF_regrid_method = "First-order Conservative"
+  end if
+  if (interp_method .eq. str_lower("bilinear")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Bilinear"
+  end if
+  if (interp_method .eq. str_lower("patch")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Higher-order Patch"
+  end if
+  if (interp_method .eq. str_lower("neareststod")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Nearest source to destination"
+  end if
+  globalAtt@conventions   = "NCAR-CSM"
+  globalAtt@domain_a      = "source_grid_file.nc"
+  globalAtt@domain_b      = "destination_grid_file.nc"
+  globalAtt@grid_file_src = "source_grid_file.nc"
+  globalAtt@grid_file_dst = "destination_grid_file.nc"
+  globalAtt@CVS_revision  = "6.3.0r"
+;
+  fileattdef( filennei, globalAtt )
+  vars = getfilevarnames (wfile)
+  nv=dimsizes(vars)
+  print(nv)
+  S_nnei=S_regrid
+  num_links= dimsizes(S_regrid)
+  var_temp=new((/1/),integer)
+  var_temp(0)=1
+  src_address!0="n_s"
+  dst_address!0="n_s"
+  S_nnei!0="n_s"
+  var_temp!0="num_wgts"
+  delete(src_address@_FillValue)
+  delete(dst_address@_FillValue)
+  delete(S_nnei@_FillValue)
+  do i = 0,nv-4
+     filennei->$vars(i)$=wfile->$vars(i)$
+  end do
+  filennei->$"col"$=src_address
+  filennei->$"row"$=dst_address
+  filennei->$"S"$=S_nnei
+  filennei->$"var_temp"$=var_temp
+
+  Opt                = True
+  Opt@Debug          = True
+  Opt@PrintTimings   = True
+  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFilennei,Opt)
+;  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFile,Opt)
+  printVarSummary(func_regrid_new)
+
+  func_regrid_msk_new  = where((1-tgt_msk) .eq. 1, func_regrid_new, msk_field_value)
+
+  delete(var_temp)
+  end if
+;--------------------------------------------
+;--- Calculate the error on the target grid
+;--------------------------------------------
+  func_ana_tgt       = where((1-tgt_msk) .eq. 1, func_ana_tgt, msk_field_value)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_new)/func_regrid_msk_new))*100, msk_err_value)
+  else
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_fillvalue)/func_regrid_msk_fillvalue))*100, msk_err_value)
+  end if
+  print("Max of the error (equal -10000 on land)")
+  printMinMax(error,True)
+  error_min = where(error .eq. msk_err_value, - msk_err_value, error)
+  print("Min of the error (equal 10000 on land)")
+  printMinMax(error_min,True)
+
+;--------------------------------------------
+;--- Output files: to plot ESMF results and create the rmp file for OASIS3-MCT
+;--------------------------------------------
+  ifile = addfile(funcini,"c")
+  ifile->$srcgrdlon$=src_lon
+  ifile->$srcgrdlat$=src_lat
+  ifile->$"field_in"$=(func_ana_src)
+
+  ofile = addfile(funcinterp,"c")
+  ofile->$tgtgrdlon$=tgt_lon
+  ofile->$tgtgrdlat$=tgt_lat
+  ofile->$"field_ana"$=(func_ana_tgt)
+  ofile->$"field_undef"$=(func_regrid)
+  ofile->$"field_msk_undef"$=(func_regrid_msk_fillvalue)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+     ofile->$"field_ou"$=(func_regrid_msk_new)
+  end if
+  ofile->$"error"$=(error)
+
+;---- Write the rmp file for OASIS3-MCT
+; if bilinear interpolation : num_wgts=1
+; if conservative interpolation : num_wgts=3
+; if nearest neighbour : num_wgts=1
+
+;--- Normalize to obtain Fracarea option for OASIS3-MCT for conservative interpolation
+  if (interp_method .eq. str_lower("conserve")) then
+     do i=0,num_links-1
+        if (frac_dst(dst_address(i)-1) .ne. 0.0) then
+           S_regrid(i)=S_regrid(i)/frac_dst(dst_address(i)-1)
+        end if
+     end do
+  end if
+
+    oa3file = addfile(oa3wgtFile,"c")
+    dst_lat_w!0="dst_grid_size"
+    src_lat_w!0="src_grid_size"
+    src_address!0="num_links"
+    dst_address!0="num_links"
+    oa3file->$"src_grid_center_lat"$=src_lat_w 
+    oa3file->$"dst_grid_center_lat"$=dst_lat_w 
+    oa3file->$"src_address"$=src_address
+    oa3file->$"dst_address"$=dst_address
+    if (interp_method .eq. "conserve") then
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=3
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp
+       var(:,1) = 0. 
+       var(:,2) = 0. 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  else
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=1
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  end if
+
+end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_curv_one_step.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_curv_one_step.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_curv_one_step.ncl	(revision 4775)
@@ -0,0 +1,448 @@
+;----------------------------------------------------------------------
+; This script regrids dummy data from a curvilinear grid to an
+; unstructured grid. Both grids are on one NetCDF file.
+;
+; There's an issue with this script if you try to apply SrcMask2D,
+; because it causes the destination grid to be reduced in the number
+; of points (24,572 to 24,067). The fix seems to be in not setting
+; SrcMask2D, but I would like to figure out why this is the case.
+;----------------------------------------------------------------------
+;--------------------------------------------
+;---- Predefined ESMF modules
+;--------------------------------------------
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+;
+; Loading a personal ESMF regridding script to provide
+; a needed bug fix for curvilinear to unstructured.
+;
+;load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl"
+load "./ESMF_regridding.ncl"
+
+begin
+;--------------------------------------------
+;--- PATHS
+;--------------------------------------------
+  RUNDIR="wkdir_esmf_"+str_lower(srcgrid)+"_"+str_lower(tgtgrid)+"_"+str_lower(interp_method)
+  PATH1="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/"
+  PATH2="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/" 
+  PATH1="./"
+  PATH2="./"
+
+; WARNING : DOES NOT WORK YET FOR CONSERVATIVE REMAPPING
+  if (str_lower(interp_method) .eq. str_lower("conserve")) then
+     print("Does not work yet for conservative remapping")
+     exit
+  end if 
+;--------------------------------------------
+;--- Source and Target grid Files used with oasis3-mct for SCRIP
+;--------------------------------------------
+  gridsfile = PATH1+"grids.nc"    ; File with grids at OASIS3-MCT description
+  masksfile = PATH1+"masks.nc"    ; File with masks at OASIS3-MCT description
+
+;--------------------------------------------
+;--- Files 
+;--------------------------------------------  
+  funcini     = PATH2+"fldin.nc"     ; File with the initial field
+  funcinterp  = PATH2+"fldou.nc"     ; File with the remapping field, error
+  srcGridName = PATH2+"source_grid_esmf.nc"
+  tgtGridName = PATH2+"target_grid_esmf.nc" 
+  wgtFile     = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + "_withfillValue.nc"
+  wgtFile1    = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_neareststod.nc"
+  wgtFilennei = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+  oa3wgtFile  = PATH2+"rmp_esmf_for_oa3mct_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+
+;--------------------------------------------
+;--- Constants
+;-------------------------------------------- 
+  msk_field_value = -1
+  msk_err_value = -10000
+  weight_fill_val = -50000
+  pi = 3.14159265359
+  dp_length = 1.2*pi
+  dp_conv   = pi/180.
+
+;--------------------------------------------
+;--- Cleaning: remove any pre-existing file
+;-------------------------------------------- 
+  system("/bin/rm -f "+funcini)
+  system("/bin/rm -f "+funcinterp)
+  system("/bin/rm -f "+srcGridName)
+  system("/bin/rm -f "+tgtGridName)
+  system("/bin/rm -f "+wgtFile)  
+  system("/bin/rm -f "+wgtFile1)  
+  system("/bin/rm -f "+wgtFilennei) 
+  system("/bin/rm -f "+oa3wgtFile)
+  system("/bin/rm -f PET0.RegridWeightGen.Log")
+
+;--------------------------------------------
+;--- Coordinate names
+;--------------------------------------------
+  srcgrdlon = srcgrid+"_lon"
+  srcgrdlat = srcgrid+"_lat"
+  srcgrdclo = srcgrid+"_clo"
+  srcgrdcla = srcgrid+"_cla"
+  srcgrdmsk = srcgrid+"_msk"
+  tgtgrdlon = tgtgrid+"_lon"
+  tgtgrdlat = tgtgrid+"_lat"
+  tgtgrdclo = tgtgrid+"_clo"
+  tgtgrdcla = tgtgrid+"_cla"
+  tgtgrdmsk = tgtgrid+"_msk"
+
+;--------------------------------------------
+;--- Read grids, masks, areas arrays
+;--------------------------------------------
+  gfile   = addfile(gridsfile,"r")
+  mfile   = addfile(masksfile,"r")
+  
+  nt=0
+  src_lon  = gfile->$srcgrdlon$(nt,:)
+  src_lat  = gfile->$srcgrdlat$(nt,:)
+  src_clo  = gfile->$srcgrdclo$(:,nt,:)
+  src_cla  = gfile->$srcgrdcla$(:,nt,:)
+  src_msk  = mfile->$srcgrdmsk$(nt,:)
+  tgt_lon  = gfile->$tgtgrdlon$
+  tgt_lat  = gfile->$tgtgrdlat$
+  tgt_clo  = gfile->$tgtgrdclo$
+  tgt_cla  = gfile->$tgtgrdcla$
+  tgt_msk  = mfile->$tgtgrdmsk$
+
+  nlatsrc=dimsizes(src_lat)
+  nlonsrc=dimsizes(src_lon)
+  nlattgt=dimsizes(tgt_lat(:,0))
+  nlontgt=dimsizes(tgt_lon(0,:))
+
+;--------------------------------------------
+;--- Calculate the function to regrid
+;--------------------------------------------
+  func_ana_src = 2. - cos(pi*(acos(cos(src_lat*dp_conv)*cos(src_lon*dp_conv))/dp_length))
+
+;--------------------------------------------
+;--- Calculate the function on the destination grid for the error
+;--------------------------------------------
+  func_ana_tgt = 2. - cos(pi*(acos(cos(tgt_lat*dp_conv)*cos(tgt_lon*dp_conv))/dp_length))
+
+;----------------------------------------------------------------------
+;--- Regridding all in one step
+;----------------------------------------------------------------------
+  Opt                   = True
+  Opt@SrcGridName       = srcGridName 
+  Opt@SrcGridLat        = src_lat
+  Opt@SrcGridLon        = src_lon
+  Opt@SrcMask2D         = 1-src_msk     ; Don't set this, otherwise you may get error.
+  Opt@DstGridName       = tgtGridName
+  Opt@DstGridLat        = tgt_lat
+  Opt@DstGridLon        = tgt_lon   
+  Opt@DstMask2D         = 1-tgt_msk
+
+  Opt@InterpMethod      = str_lower(interp_method)
+  Opt@WgtFileName       = wgtFile
+
+  if(Opt@InterpMethod.eq.str_lower("conserve")) then
+    Opt@SrcGridCornerLat  = ndtooned(src_cla)
+    Opt@SrcGridCornerLon  = ndtooned(src_clo)
+  end if
+
+  if ( interp_method .eq. str_lower("conserve") ) then
+    dims = getfilevardims(gfile,tgtgrdcla)
+;---Make sure grid is nlat x nlon x 4
+    Opt@DstGridCornerLat  = gfile->$tgtgrdcla$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)     
+    Opt@DstGridCornerLon  = gfile->$tgtgrdclo$($dims(1)$|:,$dims(2)$|:,$dims(0)$|:)
+    printMinMax(Opt@DstGridCornerLat,0)
+    printMinMax(Opt@DstGridCornerLon,0)
+  end if
+
+
+
+  Opt@ForceOverwrite    = True
+  Opt@PrintTimings      = True
+  Opt@Debug             = True
+;
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  func_regrid = ESMF_regrid(func_ana_src,Opt)
+  printVarSummary(func_regrid)
+  undef_val=func_regrid@_FillValue
+  printVarSummary(undef_val)
+  delete (Opt)
+  func_regrid_msk_fillvalue  = where((1-tgt_msk) .eq. 1, func_regrid, msk_field_value)
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+;--------------------------------------------------------------------------
+;   Do the regridding "neareststod" all in one step to fill blank points
+;--------------------------------------------------------------------------
+  Opt=True
+  Opt@SrcGridName    = srcGridName 
+  Opt@DstGridName    = tgtGridName
+  Opt@WgtFileName    = wgtFile1
+  Opt@SrcGridLat     = src_lat
+  Opt@SrcGridLon     = src_lon
+  Opt@DstGridLat     = tgt_lat
+  Opt@DstGridLon     = tgt_lon
+  Opt@DstMask2D      = 1-tgt_msk
+  Opt@SrcMask2D      = 1-src_msk
+
+  Opt@InterpMethod   = "neareststod"
+;  Opt@Pole           = "none"
+  Opt@ForceOverwrite = True
+  Opt@PrintTimings   = True
+  Opt@Debug          = True
+
+;---You can choose to skip any of these three steps.
+;  Opt@SkipSrcGrid   = True    ; Will assume source grid file has been generated
+;  Opt@SkipDstGrid   = True    ; Will assume target grid file has been generated
+;  Opt@SkipWgtGen    = True    ; Will assume weights file has been generated
+
+  func_neareststod = ESMF_regrid(func_ana_src,Opt)
+  func_neareststod = where((1-tgt_msk) .eq. 1, func_neareststod, msk_field_value)
+;----------------------------------------------------------------------
+;--- Combine interp_method + neareststod
+;----------------------------------------------------------------------
+  wfile          = addfile(wgtFile,"r")  
+;
+  S_regrid       = wfile->$"S"$
+  dst_lat_w      = wfile->$"yc_b"$
+  dst_lon_w      = wfile->$"xc_b"$
+  src_lat_w      = wfile->$"yc_a"$
+  src_lon_w      = wfile->$"xc_a"$
+  dst_address    = wfile->$"row"$
+  src_address    = wfile->$"col"$
+  frac_dst       = wfile->$"frac_b"$
+  numlinks      = dimsizes(S_regrid)
+  dst_size      = dimsizes(dst_lat_w)
+  src_size      = dimsizes(src_lat_w)
+  print("dst_size_w")
+  print(dst_size)
+;
+  wfile1            = addfile(wgtFile1,"r")
+  S_neareststod     = wfile1->$"S"$
+  dst_lat_n         = wfile1->$"yc_b"$
+  dst_lon_n         = wfile1->$"xc_b"$
+  src_lat_n         = wfile1->$"yc_a"$
+  dst_neareststod   = wfile1->$"row"$
+  src_neareststod   = wfile1->$"col"$
+  links_neareststod = dimsizes(S_neareststod)
+  dst_size_n    = dimsizes(dst_lat_n)
+  print("dst_size_n")
+  print(dst_size_n)
+;
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+      func_oned                = ndtooned(func_regrid_msk_fillvalue)
+      dst_missing              = new((/dst_size/),"integer")
+      dst_missing@_FillValue   = doubletointeger(undef_val)
+
+      count = -1
+      do i=0,dst_size-1
+         if (ismissing(func_oned(i))) then
+            count = count+1
+            dst_missing(count) = i+1
+         end if
+      end do
+; count > 0 : there are some points that need nearest neighbours
+      if (count .ge. 0) then
+      dst_missing_good    = new((/count+1/),"integer")
+      do i=0,count
+         dst_missing_good(i) = dst_missing(i)
+      end do
+      delete(dst_missing)
+      print("count")
+      print(count)
+      print("dst_missing_good")
+;      print(dst_missing_good)
+;
+;--- Replace weights where function = _FillValue by 1. (neareststod)
+      dst_address_new    = new((/numlinks+count+1/),"integer")
+      src_address_new    = new((/numlinks+count+1/),"integer")
+      S_regrid_new       = new((/numlinks+count+1/),double)
+      print("New size numlinks+count")
+      print(numlinks+count+1)
+      dst_address_new(0:numlinks-1)  = dst_address
+      src_address_new(0:numlinks-1)  = src_address
+      S_regrid_new(0:numlinks-1)     = S_regrid
+      do j=0,count
+         do i=0,links_neareststod-1
+            if ( dst_neareststod(i) .eq. dst_missing_good(j) ) then
+                dst_address_new(numlinks+j) = dst_missing_good(j)
+                src_address_new(numlinks+j) = src_neareststod(i)
+                S_regrid_new(numlinks+j)    = S_neareststod(i)
+                break
+            end if
+         end do
+     end do
+     delete(dst_missing_good)
+; count = 0
+     else
+     dst_address_new    = new((/numlinks/),"integer")
+     src_address_new    = new((/numlinks/),"integer")
+     S_regrid_new       = new((/numlinks/),double)
+     dst_address_new    = dst_address
+     src_address_new    = src_address
+     S_regrid_new       = S_regrid
+     end if
+
+     delete(S_regrid)
+     delete(dst_address)
+     delete(src_address)
+
+     igood = ind (.not. ismissing(S_regrid_new))
+     S_regrid = S_regrid_new(igood)
+     src_address = src_address_new(igood)
+     dst_address = dst_address_new(igood)
+
+; endif neareststod
+     delete(S_regrid_new)
+     delete(dst_address_new)
+     delete(src_address_new)
+     end if
+
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Recalculate the interpolated function with the new weights with ESMF
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+  filennei = addfile(wgtFilennei,"c")
+  globalAtt               = True
+  globalAtt@title         = "ESMF Offline Regridding Weight Generator"
+  globalAtt@normalization = "destarea"
+  if (interp_method .eq. str_lower("conserve")) then
+     globalAtt@map_method = "Conservative remapping"
+     globalAtt@ESMF_regrid_method = "First-order Conservative"
+  end if
+  if (interp_method .eq. str_lower("bilinear")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Bilinear"
+  end if
+  if (interp_method .eq. str_lower("patch")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Higher-order Patch"
+  end if
+  if (interp_method .eq. str_lower("neareststod")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Nearest source to destination"
+  end if
+  globalAtt@conventions   = "NCAR-CSM"
+  globalAtt@domain_a      = "source_grid_file.nc"
+  globalAtt@domain_b      = "destination_grid_file.nc"
+  globalAtt@grid_file_src = "source_grid_file.nc"
+  globalAtt@grid_file_dst = "destination_grid_file.nc"
+  globalAtt@CVS_revision  = "6.3.0r"
+;
+  fileattdef( filennei, globalAtt )
+  vars = getfilevarnames (wfile)
+  nv=dimsizes(vars)
+  print(nv)
+  S_nnei=S_regrid
+  num_links= dimsizes(S_regrid)
+  var_temp=new((/1/),integer)
+  var_temp(0)=1
+  src_address!0="n_s"
+  dst_address!0="n_s"
+  S_nnei!0="n_s"
+  var_temp!0="num_wgts"
+  delete(src_address@_FillValue)
+  delete(dst_address@_FillValue)
+  delete(S_nnei@_FillValue)
+  do i = 0,nv-4
+     filennei->$vars(i)$=wfile->$vars(i)$
+  end do
+  filennei->$"col"$=src_address
+  filennei->$"row"$=dst_address
+  filennei->$"S"$=S_nnei
+  filennei->$"var_temp"$=var_temp
+
+  Opt                = True
+  Opt@Debug          = True
+  Opt@PrintTimings   = True
+  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFilennei,Opt)
+;  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFile,Opt)
+  printVarSummary(func_regrid_new)
+
+  func_regrid_msk_new  = where((1-tgt_msk) .eq. 1, func_regrid_new, msk_field_value)
+
+  delete(var_temp)
+  end if
+;--------------------------------------------
+;--- Calculate the error on the target grid
+;--------------------------------------------
+  func_ana_tgt       = where((1-tgt_msk) .eq. 1, func_ana_tgt, msk_field_value)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_new)/func_regrid_msk_new))*100, msk_err_value)
+  else
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_fillvalue)/func_regrid_msk_fillvalue))*100, msk_err_value)
+  end if
+  print("Max of the error (equal -10000 on land)")
+  printMinMax(error,True)
+  error_min = where(error .eq. msk_err_value, - msk_err_value, error)
+  print("Min of the error (equal 10000 on land)")
+  printMinMax(error_min,True)
+
+;--------------------------------------------
+;--- Output files: to plot ESMF results and create the rmp file for OASIS3-MCT
+;--------------------------------------------
+  ifile = addfile(funcini,"c")
+  ifile->$srcgrdlon$=src_lon
+  ifile->$srcgrdlat$=src_lat
+  ifile->$"field_in"$=(func_ana_src)
+
+  ofile = addfile(funcinterp,"c")
+  ofile->$tgtgrdlon$=tgt_lon
+  ofile->$tgtgrdlat$=tgt_lat
+  ofile->$"field_ana"$=(func_ana_tgt)
+  ofile->$"field_undef"$=(func_regrid)
+  ofile->$"field_msk_undef"$=(func_regrid_msk_fillvalue)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+     ofile->$"field_ou"$=(func_regrid_msk_new)
+  end if
+  ofile->$"error"$=(error)
+
+;---- Write the rmp file for OASIS3-MCT
+; if bilinear interpolation : num_wgts=1
+; if conservative interpolation : num_wgts=3
+; if nearest neighbour : num_wgts=1
+
+;--- Normalize to obtain Fracarea option for OASIS3-MCT for conservative interpolation
+  if (interp_method .eq. str_lower("conserve")) then
+     do i=0,num_links-1
+        if (frac_dst(dst_address(i)-1) .ne. 0.0) then
+           S_regrid(i)=S_regrid(i)/frac_dst(dst_address(i)-1)
+        end if
+     end do
+  end if
+
+    oa3file = addfile(oa3wgtFile,"c")
+    dst_lat_w!0="dst_grid_size"
+    src_lat_w!0="src_grid_size"
+    src_address!0="num_links"
+    dst_address!0="num_links"
+    oa3file->$"src_grid_center_lat"$=src_lat_w 
+    oa3file->$"dst_grid_center_lat"$=dst_lat_w 
+    oa3file->$"src_address"$=src_address
+    oa3file->$"dst_address"$=dst_address
+    if (interp_method .eq. "conserve") then
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=3
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp
+       var(:,1) = 0. 
+       var(:,2) = 0. 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  else
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=1
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  end if
+
+end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_unstructured_one_step.ncl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_unstructured_one_step.ncl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/interp_esmf_unstructured_to_unstructured_one_step.ncl	(revision 4775)
@@ -0,0 +1,445 @@
+;----------------------------------------------------------------------
+; This script regrids dummy data from a curvilinear grid to an
+; unstructured grid. Both grids are on one NetCDF file.
+;
+; There's an issue with this script if you try to apply SrcMask2D,
+; because it causes the destination grid to be reduced in the number
+; of points (24,572 to 24,067). The fix seems to be in not setting
+; SrcMask2D, but I would like to figure out why this is the case.
+;----------------------------------------------------------------------
+;--------------------------------------------
+;---- Predefined ESMF modules
+;--------------------------------------------
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+;
+; Loading a personal ESMF regridding script to provide
+; a needed bug fix for curvilinear to unstructured.
+;
+;load "$NCARG_ROOT/lib/ncarg/nclscripts/esmf/ESMF_regridding.ncl"
+load "./ESMF_regridding.ncl"
+
+begin
+;--------------------------------------------
+;--- PATHS
+;--------------------------------------------
+  RUNDIR="wkdir_esmf_"+str_lower(srcgrid)+"_"+str_lower(tgtgrid)+"_"+str_lower(interp_method)
+  PATH1="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/"
+  PATH2="/home/evian/coquart/ESMF/ESMF_with_NCL/toy_calcul_weights_with_esmf/RUNDIR/" 
+  PATH1="./"
+  PATH2="./"
+
+; WARNING : DOES NOT WORK YET FOR CONSERVATIVE REMAPPING
+  if (str_lower(interp_method) .eq. str_lower("conserve")) then
+     print("Does not work yet for conservative remapping")
+     exit
+  end if 
+;--------------------------------------------
+;--- Source and Target grid Files used with oasis3-mct for SCRIP
+;--------------------------------------------
+  gridsfile = PATH1+"grids.nc"    ; File with grids at OASIS3-MCT description
+  masksfile = PATH1+"masks.nc"    ; File with masks at OASIS3-MCT description
+
+;--------------------------------------------
+;--- Files 
+;--------------------------------------------  
+  funcini     = PATH2+"fldin.nc"     ; File with the initial field
+  funcinterp  = PATH2+"fldou.nc"     ; File with the remapping field, error
+  srcGridName = PATH2+"source_grid_esmf.nc"
+  tgtGridName = PATH2+"target_grid_esmf.nc" 
+  wgtFile     = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + "_withfillValue.nc"
+  wgtFile1    = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_neareststod.nc"
+  wgtFilennei = PATH2+"rmp_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+  oa3wgtFile  = PATH2+"rmp_esmf_for_oa3mct_"+srcgrid+"to"+tgtgrid+"_" + interp_method + ".nc"
+
+;--------------------------------------------
+;--- Constants
+;-------------------------------------------- 
+  msk_field_value = -1
+  msk_err_value = -10000
+  weight_fill_val = -50000
+  pi = 3.14159265359
+  dp_length = 1.2*pi
+  dp_conv   = pi/180.
+
+;--------------------------------------------
+;--- Cleaning: remove any pre-existing file
+;-------------------------------------------- 
+  system("/bin/rm -f "+funcini)
+  system("/bin/rm -f "+funcinterp)
+  system("/bin/rm -f "+srcGridName)
+  system("/bin/rm -f "+tgtGridName)
+  system("/bin/rm -f "+wgtFile)  
+  system("/bin/rm -f "+wgtFile1)  
+  system("/bin/rm -f "+wgtFilennei) 
+  system("/bin/rm -f "+oa3wgtFile)
+  system("/bin/rm -f PET0.RegridWeightGen.Log")
+
+;--------------------------------------------
+;--- Coordinate names
+;--------------------------------------------
+  srcgrdlon = srcgrid+"_lon"
+  srcgrdlat = srcgrid+"_lat"
+  srcgrdclo = srcgrid+"_clo"
+  srcgrdcla = srcgrid+"_cla"
+  srcgrdmsk = srcgrid+"_msk"
+  tgtgrdlon = tgtgrid+"_lon"
+  tgtgrdlat = tgtgrid+"_lat"
+  tgtgrdclo = tgtgrid+"_clo"
+  tgtgrdcla = tgtgrid+"_cla"
+  tgtgrdmsk = tgtgrid+"_msk"
+
+;--------------------------------------------
+;--- Read grids, masks, areas arrays
+;--------------------------------------------
+  gfile   = addfile(gridsfile,"r")
+  mfile   = addfile(masksfile,"r")
+  
+  nt=0
+  src_lon  = gfile->$srcgrdlon$(nt,:)
+  src_lat  = gfile->$srcgrdlat$(nt,:)
+  src_clo  = gfile->$srcgrdclo$(:,nt,:)
+  src_cla  = gfile->$srcgrdcla$(:,nt,:)
+  src_msk  = mfile->$srcgrdmsk$(nt,:)
+  tgt_lon  = gfile->$tgtgrdlon$(nt,:)
+  tgt_lat  = gfile->$tgtgrdlat$(nt,:)
+  tgt_clo  = gfile->$tgtgrdclo$(:,nt,:)
+  tgt_cla  = gfile->$tgtgrdcla$(:,nt,:)
+  tgt_msk  = mfile->$tgtgrdmsk$(nt,:)
+
+  nlatsrc=dimsizes(src_lat)
+  nlonsrc=dimsizes(src_lon)
+  nlattgt=dimsizes(tgt_lat)
+  nlontgt=dimsizes(tgt_lon)
+
+;--------------------------------------------
+;--- Calculate the function to regrid
+;--------------------------------------------
+  func_ana_src = 2. - cos(pi*(acos(cos(src_lat*dp_conv)*cos(src_lon*dp_conv))/dp_length))
+
+;--------------------------------------------
+;--- Calculate the function on the destination grid for the error
+;--------------------------------------------
+  func_ana_tgt = 2. - cos(pi*(acos(cos(tgt_lat*dp_conv)*cos(tgt_lon*dp_conv))/dp_length))
+
+;----------------------------------------------------------------------
+;--- Regridding all in one step
+;----------------------------------------------------------------------
+  Opt                   = True
+  Opt@SrcGridName       = srcGridName 
+  Opt@SrcGridLat        = src_lat
+  Opt@SrcGridLon        = src_lon
+  Opt@SrcMask2D         = 1-src_msk     ; Don't set this, otherwise you may get error.
+  Opt@DstGridName       = tgtGridName
+  Opt@DstGridLat        = tgt_lat
+  Opt@DstGridLon        = tgt_lon   
+  Opt@DstMask2D         = 1-tgt_msk
+  Opt@DstGridType       = "unstructured"
+
+  Opt@InterpMethod      = str_lower(interp_method)
+  Opt@WgtFileName       = wgtFile
+
+  if(Opt@InterpMethod.eq.str_lower("conserve")) then
+    Opt@SrcGridCornerLat  = ndtooned(src_cla)
+    Opt@SrcGridCornerLon  = ndtooned(src_clo)
+  end if
+
+  if(Opt@InterpMethod.eq.str_lower("conserve")) then
+    Opt@DstGridCornerLat  = ndtooned(tgt_cla)
+    Opt@DstGridCornerLon  = ndtooned(tgt_clo)
+  end if
+
+  Opt@ForceOverwrite    = True
+  Opt@PrintTimings      = True
+  Opt@Debug             = True
+;
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  func_regrid = ESMF_regrid(func_ana_src,Opt)
+  printVarSummary(func_regrid)
+  undef_val=func_regrid@_FillValue
+  printVarSummary(undef_val)
+  delete (Opt)
+  func_regrid_msk_fillvalue  = where((1-tgt_msk) .eq. 1, func_regrid, msk_field_value)
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+;--------------------------------------------------------------------------
+;   Do the regridding "neareststod" all in one step to fill blank points
+;--------------------------------------------------------------------------
+  Opt=True
+  Opt@SrcGridName    = srcGridName 
+  Opt@DstGridName    = tgtGridName
+  Opt@WgtFileName    = wgtFile1
+  Opt@SrcGridLat     = src_lat
+  Opt@SrcGridLon     = src_lon
+  Opt@DstGridLat     = tgt_lat
+  Opt@DstGridLon     = tgt_lon
+  Opt@DstMask2D      = 1-tgt_msk
+  Opt@SrcMask2D      = 1-src_msk
+
+  Opt@DstGridType       = "unstructured"
+
+  Opt@InterpMethod   = "neareststod"
+;  Opt@Pole           = "none"
+  Opt@ForceOverwrite = True
+  Opt@PrintTimings   = True
+  Opt@Debug          = True
+
+;---You can choose to skip any of these three steps.
+;  Opt@SkipSrcGrid   = True    ; Will assume source grid file has been generated
+;  Opt@SkipDstGrid   = True    ; Will assume target grid file has been generated
+;  Opt@SkipWgtGen    = True    ; Will assume weights file has been generated
+
+  func_neareststod = ESMF_regrid(func_ana_src,Opt)
+  func_neareststod = where((1-tgt_msk) .eq. 1, func_neareststod, msk_field_value)
+;----------------------------------------------------------------------
+;--- Combine interp_method + neareststod
+;----------------------------------------------------------------------
+  wfile          = addfile(wgtFile,"r")  
+;
+  S_regrid       = wfile->$"S"$
+  dst_lat_w      = wfile->$"yc_b"$
+  dst_lon_w      = wfile->$"xc_b"$
+  src_lat_w      = wfile->$"yc_a"$
+  src_lon_w      = wfile->$"xc_a"$
+  dst_address    = wfile->$"row"$
+  src_address    = wfile->$"col"$
+  frac_dst       = wfile->$"frac_b"$
+  numlinks      = dimsizes(S_regrid)
+  dst_size      = dimsizes(dst_lat_w)
+  src_size      = dimsizes(src_lat_w)
+  print("dst_size_w")
+  print(dst_size)
+;
+  wfile1            = addfile(wgtFile1,"r")
+  S_neareststod     = wfile1->$"S"$
+  dst_lat_n         = wfile1->$"yc_b"$
+  dst_lon_n         = wfile1->$"xc_b"$
+  src_lat_n         = wfile1->$"yc_a"$
+  dst_neareststod   = wfile1->$"row"$
+  src_neareststod   = wfile1->$"col"$
+  links_neareststod = dimsizes(S_neareststod)
+  dst_size_n    = dimsizes(dst_lat_n)
+  print("dst_size_n")
+  print(dst_size_n)
+;
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+      func_oned                = ndtooned(func_regrid_msk_fillvalue)
+      dst_missing              = new((/dst_size/),"integer")
+      dst_missing@_FillValue   = doubletointeger(undef_val)
+
+      count = -1
+      do i=0,dst_size-1
+         if (ismissing(func_oned(i))) then
+            count = count+1
+            dst_missing(count) = i+1
+         end if
+      end do
+; count > 0 : there are some points that need nearest neighbours
+      if (count .ge. 0) then
+      dst_missing_good    = new((/count+1/),"integer")
+      do i=0,count
+         dst_missing_good(i) = dst_missing(i)
+      end do
+      delete(dst_missing)
+      print("count")
+      print(count)
+      print("dst_missing_good")
+;      print(dst_missing_good)
+;
+;--- Replace weights where function = _FillValue by 1. (neareststod)
+      dst_address_new    = new((/numlinks+count+1/),"integer")
+      src_address_new    = new((/numlinks+count+1/),"integer")
+      S_regrid_new       = new((/numlinks+count+1/),double)
+      print("New size numlinks+count")
+      print(numlinks+count+1)
+      dst_address_new(0:numlinks-1)  = dst_address
+      src_address_new(0:numlinks-1)  = src_address
+      S_regrid_new(0:numlinks-1)     = S_regrid
+      do j=0,count
+         do i=0,links_neareststod-1
+            if ( dst_neareststod(i) .eq. dst_missing_good(j) ) then
+                dst_address_new(numlinks+j) = dst_missing_good(j)
+                src_address_new(numlinks+j) = src_neareststod(i)
+                S_regrid_new(numlinks+j)    = S_neareststod(i)
+                break
+            end if
+         end do
+     end do
+     delete(dst_missing_good)
+; count = 0
+     else
+     dst_address_new    = new((/numlinks/),"integer")
+     src_address_new    = new((/numlinks/),"integer")
+     S_regrid_new       = new((/numlinks/),double)
+     dst_address_new    = dst_address
+     src_address_new    = src_address
+     S_regrid_new       = S_regrid
+     end if
+
+     delete(S_regrid)
+     delete(dst_address)
+     delete(src_address)
+
+     igood = ind (.not. ismissing(S_regrid_new))
+     S_regrid = S_regrid_new(igood)
+     src_address = src_address_new(igood)
+     dst_address = dst_address_new(igood)
+
+; endif neareststod
+     delete(S_regrid_new)
+     delete(dst_address_new)
+     delete(src_address_new)
+     end if
+
+;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+; Recalculate the interpolated function with the new weights with ESMF
+; Points that receive no values are at _FillValue=9.96920996838687e+36 (blank points)
+  if (interp_method .eq. str_lower("neareststod")) then
+;--- Just write the new weights into the remapping file
+     print("Nothing to do")
+  else 
+  filennei = addfile(wgtFilennei,"c")
+  globalAtt               = True
+  globalAtt@title         = "ESMF Offline Regridding Weight Generator"
+  globalAtt@normalization = "destarea"
+  if (interp_method .eq. str_lower("conserve")) then
+     globalAtt@map_method = "Conservative remapping"
+     globalAtt@ESMF_regrid_method = "First-order Conservative"
+  end if
+  if (interp_method .eq. str_lower("bilinear")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Bilinear"
+  end if
+  if (interp_method .eq. str_lower("patch")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Higher-order Patch"
+  end if
+  if (interp_method .eq. str_lower("neareststod")) then
+     globalAtt@map_method = "Bilinear remapping"
+     globalAtt@ESMF_regrid_method = "Nearest source to destination"
+  end if
+  globalAtt@conventions   = "NCAR-CSM"
+  globalAtt@domain_a      = "source_grid_file.nc"
+  globalAtt@domain_b      = "destination_grid_file.nc"
+  globalAtt@grid_file_src = "source_grid_file.nc"
+  globalAtt@grid_file_dst = "destination_grid_file.nc"
+  globalAtt@CVS_revision  = "6.3.0r"
+;
+  fileattdef( filennei, globalAtt )
+  vars = getfilevarnames (wfile)
+  nv=dimsizes(vars)
+  print(nv)
+  S_nnei=S_regrid
+  num_links= dimsizes(S_regrid)
+  var_temp=new((/1/),integer)
+  var_temp(0)=1
+  src_address!0="n_s"
+  dst_address!0="n_s"
+  S_nnei!0="n_s"
+  var_temp!0="num_wgts"
+  delete(src_address@_FillValue)
+  delete(dst_address@_FillValue)
+  delete(S_nnei@_FillValue)
+  do i = 0,nv-4
+     filennei->$vars(i)$=wfile->$vars(i)$
+  end do
+  filennei->$"col"$=src_address
+  filennei->$"row"$=dst_address
+  filennei->$"S"$=S_nnei
+  filennei->$"var_temp"$=var_temp
+
+  Opt                = True
+  Opt@Debug          = True
+  Opt@PrintTimings   = True
+  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFilennei,Opt)
+;  func_regrid_new = ESMF_regrid_with_weights(func_ana_src,wgtFile,Opt)
+  printVarSummary(func_regrid_new)
+
+  func_regrid_msk_new  = where((1-tgt_msk) .eq. 1, func_regrid_new, msk_field_value)
+
+  delete(var_temp)
+  end if
+;--------------------------------------------
+;--- Calculate the error on the target grid
+;--------------------------------------------
+  func_ana_tgt       = where((1-tgt_msk) .eq. 1, func_ana_tgt, msk_field_value)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_new)/func_regrid_msk_new))*100, msk_err_value)
+  else
+       error = where((1-tgt_msk) .eq. 1, abs(((func_ana_tgt - func_regrid_msk_fillvalue)/func_regrid_msk_fillvalue))*100, msk_err_value)
+  end if
+  print("Max of the error (equal -10000 on land)")
+  printMinMax(error,True)
+  error_min = where(error .eq. msk_err_value, - msk_err_value, error)
+  print("Min of the error (equal 10000 on land)")
+  printMinMax(error_min,True)
+
+;--------------------------------------------
+;--- Output files: to plot ESMF results and create the rmp file for OASIS3-MCT
+;--------------------------------------------
+  ifile = addfile(funcini,"c")
+  ifile->$srcgrdlon$=src_lon
+  ifile->$srcgrdlat$=src_lat
+  ifile->$"field_in"$=(func_ana_src)
+
+  ofile = addfile(funcinterp,"c")
+  ofile->$tgtgrdlon$=tgt_lon
+  ofile->$tgtgrdlat$=tgt_lat
+  ofile->$"field_ana"$=(func_ana_tgt)
+  ofile->$"field_undef"$=(func_regrid)
+  ofile->$"field_msk_undef"$=(func_regrid_msk_fillvalue)
+  if ( (interp_method .eq. "conserve") .or. (interp_method .eq. "bilinear") .or. (interp_method .eq. "patch") ) then
+     ofile->$"field_ou"$=(func_regrid_msk_new)
+  end if
+  ofile->$"error"$=(error)
+
+;---- Write the rmp file for OASIS3-MCT
+; if bilinear interpolation : num_wgts=1
+; if conservative interpolation : num_wgts=3
+; if nearest neighbour : num_wgts=1
+
+;--- Normalize to obtain Fracarea option for OASIS3-MCT for conservative interpolation
+  if (interp_method .eq. str_lower("conserve")) then
+     do i=0,num_links-1
+        if (frac_dst(dst_address(i)-1) .ne. 0.0) then
+           S_regrid(i)=S_regrid(i)/frac_dst(dst_address(i)-1)
+        end if
+     end do
+  end if
+
+    oa3file = addfile(oa3wgtFile,"c")
+    dst_lat_w!0="dst_grid_size"
+    src_lat_w!0="src_grid_size"
+    src_address!0="num_links"
+    dst_address!0="num_links"
+    oa3file->$"src_grid_center_lat"$=src_lat_w 
+    oa3file->$"dst_grid_center_lat"$=dst_lat_w 
+    oa3file->$"src_address"$=src_address
+    oa3file->$"dst_address"$=dst_address
+    if (interp_method .eq. "conserve") then
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=3
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp
+       var(:,1) = 0. 
+       var(:,2) = 0. 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  else
+       var_temp=S_regrid
+       num_links=dimsizes(var_temp)
+       num_wgts=1
+       var = new ((/num_links,num_wgts/),double)
+       var(:,0) = var_temp 
+       var!0="num_links"
+       var!1="num_wgts"
+       oa3file->$"remap_matrix"$=var
+  end if
+
+end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_curv_grids.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_curv_grids.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_curv_grids.sh	(revision 4775)
@@ -0,0 +1,26 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids (4 characters)
+srcgrid=torc
+tgtgrid=lmdz
+# Remapping (done with ESMF in an NCL program see below)
+interp_method=bilinear
+#interp_method=patch
+#interp_method=neareststod
+#interp_method=conserve
+#
+RUNDIR=$HOMEDIR/wkdir_esmf_${srcgrid}_${tgtgrid}_${interp_method}
+DATAGRIDS=$HOMEDIR/data_esmf
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grids and masks files 
+ln -sf $DATAGRIDS/grids_all.nc $RUNDIR/grids.nc
+ln -sf $DATAGRIDS/masks_all.nc $RUNDIR/masks.nc
+#
+# Remapping using ESMF with NCL
+echo "Running interp_esmf_curv_to_curv_one_step.ncl"
+cp $HOMEDIR/interp_esmf_curv_to_curv_one_step.ncl $RUNDIR/interp_esmf_curv_to_curv_one_step.ncl
+ncl 'interp_method="'${interp_method}'"' 'srcgrid="'${srcgrid}'"' 'tgtgrid="'${tgtgrid}'"' interp_esmf_curv_to_curv_one_step.ncl
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_unstructured_grids.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_unstructured_grids.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_curv_to_unstructured_grids.sh	(revision 4775)
@@ -0,0 +1,28 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids (4 characters)
+srcgrid=lmdz
+tgtgrid=bt42
+# Remapping (done with ESMF in an NCL program see below)
+interp_method=bilinear
+#interp_method=patch
+#interp_method=neareststod
+# DOES NOT WORK YET : interp_method=conserve
+#
+RUNDIR=$HOMEDIR/wkdir_esmf_${srcgrid}_${tgtgrid}_${interp_method}
+DATAGRIDS=$HOMEDIR/data_esmf
+REGRID_ESMF_FILE=$HOMEDIR/esmf_regridding_unstructured
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grids and masks files 
+ln -sf $DATAGRIDS/grids_all.nc $RUNDIR/grids.nc
+ln -sf $DATAGRIDS/masks_all.nc $RUNDIR/masks.nc
+#
+# Remapping using local ESMF ESMF_regridding.ncl with NCL
+echo "Running interp_esmf_curv_to_unstructured_one_step.ncl"
+cp $HOMEDIR/interp_esmf_curv_to_unstructured_one_step.ncl $RUNDIR/interp_esmf_curv_to_unstructured_one_step.ncl
+cp $REGRID_ESMF_FILE/ESMF_regridding.ncl $RUNDIR/ESMF_regridding.ncl
+ncl 'interp_method="'${interp_method}'"' 'srcgrid="'${srcgrid}'"' 'tgtgrid="'${tgtgrid}'"' interp_esmf_curv_to_unstructured_one_step.ncl
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_curv_grids.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_curv_grids.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_curv_grids.sh	(revision 4775)
@@ -0,0 +1,28 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids (4 characters)
+srcgrid=bt42
+tgtgrid=lmdz
+# Remapping (done with ESMF in an NCL program see below)
+interp_method=bilinear
+#interp_method=patch
+#interp_method=neareststod
+# DOES NOT WORK YET : interp_method=conserve
+#
+RUNDIR=$HOMEDIR/wkdir_esmf_${srcgrid}_${tgtgrid}_${interp_method}
+DATAGRIDS=$HOMEDIR/data_esmf
+REGRID_ESMF_FILE=$HOMEDIR/esmf_regridding_unstructured
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grids and masks files 
+ln -sf $DATAGRIDS/grids_all.nc $RUNDIR/grids.nc
+ln -sf $DATAGRIDS/masks_all.nc $RUNDIR/masks.nc
+#
+# Remapping using local ESMF ESMF_regridding.ncl with NCL
+echo "Running interp_esmf_unstructured_to_curv_one_step.ncl"
+cp $HOMEDIR/interp_esmf_unstructured_to_curv_one_step.ncl $RUNDIR/interp_esmf_unstructured_to_curv_one_step.ncl
+cp $REGRID_ESMF_FILE/ESMF_regridding.ncl $RUNDIR/ESMF_regridding.ncl
+ncl 'interp_method="'${interp_method}'"' 'srcgrid="'${srcgrid}'"' 'tgtgrid="'${tgtgrid}'"' interp_esmf_unstructured_to_curv_one_step.ncl
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_unstructured_grids.sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_unstructured_grids.sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/test_rmp_esmf/script_interp_with_esmf_unstructured_to_unstructured_grids.sh	(revision 4775)
@@ -0,0 +1,28 @@
+#!/bin/ksh
+#
+HOMEDIR=`pwd`
+#
+# Name of the grids (4 characters)
+srcgrid=t127
+tgtgrid=bt42
+# Remapping (done with ESMF in an NCL program see below)
+#interp_method=bilinear
+interp_method=patch
+#interp_method=neareststod
+# DOES NOT WORK YET : interp_method=conserve
+#
+RUNDIR=$HOMEDIR/wkdir_esmf_${srcgrid}_${tgtgrid}_${interp_method}
+DATAGRIDS=$HOMEDIR/data_esmf
+REGRID_ESMF_FILE=$HOMEDIR/esmf_regridding_unstructured
+[ -d $RUNDIR ] || mkdir $RUNDIR
+cd $RUNDIR
+#
+# Copy grids and masks files 
+ln -sf $DATAGRIDS/grids_all.nc $RUNDIR/grids.nc
+ln -sf $DATAGRIDS/masks_all.nc $RUNDIR/masks.nc
+#
+# Remapping using local ESMF ESMF_regridding.ncl with NCL
+echo "Running interp_esmf_unstructured_to_unstructured_one_step.ncl"
+cp $HOMEDIR/interp_esmf_unstructured_to_unstructured_one_step.ncl $RUNDIR/interp_esmf_unstructured_to_unstructured_one_step.ncl
+cp $REGRID_ESMF_FILE/ESMF_regridding.ncl $RUNDIR/ESMF_regridding.ncl
+ncl 'interp_method="'${interp_method}'"' 'srcgrid="'${srcgrid}'"' 'tgtgrid="'${tgtgrid}'"' interp_esmf_unstructured_to_unstructured_one_step.ncl
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/Makefile	(revision 4775)
@@ -0,0 +1,93 @@
+#
+include ../../util/make_dir/make.inc
+LIBPSMILE = $(ARCHDIR)/lib/libpsmile.${CHAN}.a $(ARCHDIR)/lib/libmct.a $(ARCHDIR)/lib/libmpeu.a $(ARCHDIR)/lib/libscrip.a
+#
+##### User configurable options #####
+#
+# CPP keys for model 1 (_M1) and for model 2 (_M2)
+# type of decomposition :
+# DECOMP_APPLE for 1D decomposition
+# DECOMP_BOX for 2D decomposition
+CPPKEYDECOMP_M1=DECOMP_APPLE
+CPPKEYDECOMP_M2=DECOMP_APPLE
+#
+# Precision for REAL: USE_DOUBLE_PRECISION or NO_USE_DOUBLE_PRECISION
+CPPKEYDP=USE_DOUBLE_PRECISION
+#
+### End User configurable options ###
+#
+# For single precision, add -DNO_USE_DOUBLE_PRECISION in CPPLOCAL_M1/M2
+CPPLOCAL_M1 =  -D${CPPKEYDECOMP_M1} -D${CPPKEYDP}
+CPPLOCAL_M2 = -D${CPPKEYDECOMP_M2} -D${CPPKEYDP}
+#
+OBJ_M1 =  routine_hdlerr.o read_dimgrid.o  \
+          read_grid.o decomp_def.o \
+          function_sent.o 
+OBJ_M2 =  routine_hdlerr.o read_dimgrid.o  \
+          read_grid.o decomp_def_m2.o \
+          function_sent_m2.o 
+#-------------------------------------------------------------------------------
+# General rules
+#-------------------------------------------------------------------------------
+#
+default: all
+#
+all: oasis3_psmile model1 model2 
+#
+# Compile and link libaries
+oasis3_psmile:
+	(cd ../../util/make_dir ; $(MAKE) oasis3_psmile -f TopMakefileOasis3)
+#
+#
+#-------------------------------------------------------------------------------
+# Rules for executables
+#-------------------------------------------------------------------------------
+#
+model1: $(OBJ_M1) model1.o $(LIBPSMILE) Makefile
+	$(LD) $(LDFLAGS) -o $@ $(OBJ_M1) model1.o $(LIBPSMILE) $(FLIBS)
+model2: $(OBJ_M2) model2.o $(LIBPSMILE) Makefile
+	$(LD) $(LDFLAGS) -o $@ $(OBJ_M2) model2.o $(LIBPSMILE) $(FLIBS)
+#
+#-------------------------------------------------------------------------------
+# Rules for compilation
+#-------------------------------------------------------------------------------
+#
+routine_hdlerr.o :	routine_hdlerr.F90
+				$(F90) $(F90FLAGS) -c routine_hdlerr.F90
+read_dimgrid.o :	read_dimgrid.F90
+				$(F90) $(F90FLAGS) -c read_dimgrid.F90
+read_grid.o :		read_grid.F90
+				$(F90) $(F90FLAGS) -c read_grid.F90
+decomp_def.o : 		decomp_def.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M1) -c decomp_def.F90
+function_sent.o :	function_sent.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M1) -c function_sent.F90
+decomp_def_m2.o : 	decomp_def.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M2) -o decomp_def_m2.o -c decomp_def.F90
+function_sent_m2.o :	function_sent.F90
+				$(F90) $(F90FLAGS) $(CPPLOCAL_M2) -o function_sent_m2.o -c function_sent.F90
+
+model1.o :	model1.F90 Makefile
+		$(F90) $(F90FLAGS) $(CPPLOCAL_M1) -c model1.F90
+model2.o :	model2.F90 Makefile
+		$(F90) $(F90FLAGS) $(CPPLOCAL_M2) -c model2.F90
+#
+#-------------------------------------------------------------------------------
+# Utilities
+#-------------------------------------------------------------------------------
+#
+help:
+	more Make.help
+#
+# Clean directory
+#
+clean:
+	-rm -f *.o *.mod *.MOD model1 model2
+	-rm -f i.*.F90 *.L
+	-rm -f core core.* 
+#
+# Make sure to recompile everything
+#
+realclean: clean remove
+remove:
+	(cd ../../util/make_dir ; $(MAKE) realclean -f TopMakefileOasis3)
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/namcouple_TP
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/namcouple_TP	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/namcouple_TP	(revision 4775)
@@ -0,0 +1,92 @@
+# This is a typical input file for OASIS3-MCT.
+# Keywords used in previous versions of OASIS3 
+# but now obsolete are marked "Not used"
+# Don't hesitate to ask precisions or make suggestions (oasishelp@cerfacs.fr). 
+#
+# Any line beginning with # is ignored. Blank lines are not allowed.
+#
+#########################################################################
+ $NFIELDS
+# The number of fields described in the second part of the namcouple.
+#
+             3
+ $END
+#########################################################################
+ $NBMODEL
+# The number of models in this experiment + their names (6 characters)
+#
+   2  model1   model2
+ $END
+###########################################################################
+ $RUNTIME
+# The total simulated time for this run in seconds
+#
+  21600
+ $END
+###########################################################################
+ $NLOGPRT
+# Amount of information written to OASIS3-MCT log files (see User Guide)
+  10
+ $END
+###########################################################################
+ $STRINGS
+#
+# The above variables are the general parameters for the experiment.
+# Everything below has to do with the fields being exchanged.
+#
+######################################################
+#
+# Field 1: model1 to model2 
+#
+#   First line:
+# 1) and 2) Symbolic names for the field before and after interpolation
+#           (8 characters maximum)
+# 3) Index of field in cf_name_table.txt
+# 4) Exchange frequency for the field in seconds (here 1 day)
+# 5) Number of analysis to be performed
+# 6) Restart input NetCDF file names
+# 7) Field status: EXPORTED, EXPOUT, INPUT, OUTPUT
+#    (For OASIS3-MCT, IGNORED/IGNOUT are converted to EXPORTED/EXPOUT)
+#
+FSENDOCN FRECVATM 1 7200  1  fdocn.nc EXPOUT
+#
+#   Second line:
+# 1)-2) and 3)-4) Source and target grids first and 2nd dimensions (optional)
+# 5) and 6) Source and target locator prefix (4 characters)
+# 7) LAG index if needed
+# 8) SEQ index if needed
+#
+182 149 96 72 torc  lmdz  LAG=+3600
+#
+#   Third line:
+# Overlap (P or R) and nbr of overlap grid points for source and target grids.
+P  2  P  0
+#
+# List of analyses
+#
+MAPPING
+# Specific parameters for each analysis
+my_remapping_file_bilinear.nc src
+#
+######################################################
+#
+# Field 2: model1 output
+#
+FSENDOCN FSENDOCN 1 7200 1 f2avg.nc OUTPUT
+torc  torc
+LOCTRANS
+  AVERAGE
+#
+######################################################
+#
+# Field 3: model2 to model1
+#
+FSENDATM  FRECVOCN  1 10800  1  fdatm.nc EXPOUT
+#
+96 72 182 149 lmdz torc LAG=+1800
+#
+P  0  P  2
+SCRIPR
+BILINEAR LR SCALAR LATLON 1
+#
+ $END
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVATM.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVATM.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVATM.jnl	(revision 4775)
@@ -0,0 +1,4 @@
+use FRECVATM_model2_01.nc
+shade FRECVATM[k=1,d=1]
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVOCN.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVOCN.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FRECVOCN.jnl	(revision 4775)
@@ -0,0 +1,5 @@
+use FRECVOCN_model1_03.nc
+shade FRECVOCN[k=1,d=1]
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDATM.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDATM.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDATM.jnl	(revision 4775)
@@ -0,0 +1,5 @@
+use FSENDATM_model2_02.nc
+shade FSENDATM[k=1,d=1]
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_ATM.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_ATM.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_ATM.jnl	(revision 4775)
@@ -0,0 +1,5 @@
+use FSENDOCN_model1_01.nc
+shade FSENDOCN[k=1,d=1]
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_File.jnl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_File.jnl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/data_oasis3/script_ferret_FSENDOCN_to_File.jnl	(revision 4775)
@@ -0,0 +1,5 @@
+use FSENDOCN_model1_02.nc
+shade FSENDOCN[k=3,d=1]
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90	(revision 4775)
@@ -0,0 +1,52 @@
+!****************************************************************************************
+SUBROUTINE decomp_def(id_paral,id_size,id_im,id_jm,id_rank,id_npes,id_unit)
+  !
+  IMPLICIT NONE
+  INTEGER, DIMENSION(id_size), INTENT(out) :: id_paral(id_size)    
+  INTEGER, INTENT(in)  :: id_size
+  INTEGER, INTENT(in)  :: id_im       ! Grid dimension in i
+  INTEGER, INTENT(in)  :: id_jm       ! Grid dimension in j
+  INTEGER, INTENT(in)  :: id_rank     ! Rank of process
+  INTEGER, INTENT(in)  :: id_npes     ! Number of processes involved in the coupling
+  INTEGER, INTENT(in)  :: id_unit     ! Unit of log file
+  INTEGER              :: il_imjm, il_partj
+  !
+  il_imjm = id_im*id_jm
+  il_partj = id_jm/id_npes  ! Nbr of latitude circles in the partition
+  !
+#ifdef DECOMP_APPLE
+  ! Each process is responsible for a part of field defined by
+  ! the number of grid points and the offset of the first point
+  !
+  WRITE (id_unit,*) 'APPLE partitioning'
+  !
+  IF (id_rank .LT. (id_npes-1)) THEN
+      id_paral (1) = 1
+      id_paral (2) = id_rank*(il_partj * id_im)
+      id_paral (3) = il_partj * id_im
+  ELSE
+      id_paral (1) = 1
+      id_paral (2) = id_rank*(il_partj * id_im)
+      id_paral (3) = il_imjm-(id_rank*(il_partj * id_im))
+  ENDIF
+  !
+#elif defined DECOMP_BOX
+  !
+  WRITE (id_unit,*) 'BOX partitioning'
+  !
+  ! Each process is responsible for a rectangular box of il_partj lines
+  !
+  id_paral (1) = 2
+  id_paral (5) = id_im
+  id_paral (2) = id_rank*il_partj*id_im
+  id_paral (3) = id_im
+  IF (id_rank .LT. (id_npes-1)) THEN
+      id_paral (4) = il_partj
+  ELSE
+      id_paral (4) = id_jm-(id_rank*il_partj)
+  ENDIF
+  !
+#endif
+  !
+END SUBROUTINE decomp_def
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90_monoonly
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90_monoonly	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/decomp_def.F90_monoonly	(revision 4775)
@@ -0,0 +1,29 @@
+!****************************************************************************************
+SUBROUTINE decomp_def(id_paral,id_size,id_im,id_jm,id_rank,id_npes,id_unit)
+  !
+  IMPLICIT NONE
+  INTEGER, DIMENSION(id_size), INTENT(out) :: id_paral(id_size)    
+  INTEGER, INTENT(in)  :: id_size
+  INTEGER, INTENT(in)  :: id_im       ! Grid dimension in i
+  INTEGER, INTENT(in)  :: id_jm       ! Grid dimension in j
+  INTEGER, INTENT(in)  :: id_rank     ! Rank of process
+  INTEGER, INTENT(in)  :: id_npes     ! Number of processes involved in the coupling
+  INTEGER, INTENT(in)  :: id_unit     ! Unit of log file
+  INTEGER              :: il_imjm, il_partj
+  !
+#ifdef DECOMP_APPLE
+  ! APPLE for the global grid
+  id_paral(1) = 1
+  id_paral(2) = 0
+  id_paral(3) = id_im*id_jm
+#elif defined DECOMP_BOX
+  ! BOX for the global grid (no partition)
+  id_paral(1) = 2 
+  id_paral(2) = 0 
+  id_paral(3) = id_im 
+  id_paral(4) = id_jm
+  id_paral(5) = id_im 
+#endif
+  !
+END SUBROUTINE decomp_def
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/function_sent.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/function_sent.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/function_sent.F90	(revision 4775)
@@ -0,0 +1,41 @@
+SUBROUTINE function_sent(ni,nj, &
+                         coords_1,coords_2, &
+                         fnc_ana,ib)
+  !*********************************************************************************************************************
+  !
+  IMPLICIT NONE
+  !
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  ! Constants
+  !
+  REAL (kind=wp), PARAMETER    :: coef = 2.
+  !
+  REAL (kind=wp), PARAMETER    :: dp_pi=3.14159265359
+  REAL (kind=wp), PARAMETER    :: dp_length= 1.2*dp_pi
+  REAL (kind=wp), PARAMETER    :: dp_conv = dp_pi/180.
+  !
+  INTEGER, INTENT(in) :: ni,nj,ib
+  !
+  INTEGER             :: i,j
+  !
+  REAL (kind=wp), INTENT(out)            :: fnc_ana(ni,nj)
+  !
+  REAL (kind=wp)                         :: coords_1(ni,nj)
+  REAL (kind=wp)                         :: coords_2(ni,nj)
+  !
+  !
+  DO j=1,nj
+    DO i=1,ni
+      fnc_ana(i,j) =  ib*(coef - COS(dp_pi*(ACOS(COS(coords_2(i,j)* dp_conv)* &
+         COS(coords_1(i,j)* dp_conv))/dp_length)))
+    ENDDO
+  ENDDO
+  !
+  !
+END SUBROUTINE function_sent
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90	(revision 4775)
@@ -0,0 +1,312 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+!
+PROGRAM model1
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER   :: data_filename='grid_model1.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model1'
+  CHARACTER(len=128) :: comp_out ! name of the output log file 
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc             ! number of corners
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat ! lon, lat of the points
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla ! lon, lat of the corners
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf ! surface of the grid meshes
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point  
+  !
+  INTEGER :: mype, npes ! rank and  number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FSENDOCN' ! 8 characters field sent by model1 to model2
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FRECVOCN' ! 8 characters field received by model1 from model2
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 6 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 3600       ! time step
+  !
+  !
+  INTEGER                 :: il_flag  ! Flag for grid writing by proc 0
+  !
+  INTEGER                 :: itap_sec ! Time used in oasis_put/get
+  !
+  ! Grid parameters definition
+  INTEGER                 :: part_id  ! use to connect the partition to the variables
+                                      ! in oasis_def_var
+  INTEGER                 :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                 ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_send(:,:)
+  REAL (kind=wp), POINTER :: field2_recv(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL MPI_Init(ierror)
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here OASIS initialisation call !
+  !
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 103')
+  ENDIF
+  !
+  w_unit = 100 + rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  localComm = MPI_COMM_WORLD
+  ! TOCOMPLETE - Put here OASIS call to get local MPI communicator !
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 126')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 132')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), 'local rank', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grid netcdf file
+  !
+  ! Reading dimensions of the global grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the global grid
+  CALL read_grid(nlon,nlat,nc, data_filename, w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+      !
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  !
+  ! TOCOMPLETE - Put here OASIS call to define local partition !
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!! !!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !  Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  !
+  ! Declaration of the field associated with the partition
+  !
+  ! TOCOMPLETE - Put here OASIS call to declare the coupling fields
+  !              FRECVOCN, FSENDOCN
+  ! var_name1 = 'FSENDOCN'
+  ! var_name2 = 'FRECVOCN'
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here the OASIS call to end the definition phase
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  !
+  ALLOCATE(field1_send(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_send'
+  !
+  ALLOCATE(field2_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_recv'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!! 
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange 
+  ! 
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    ! Get FRECVOCN
+    ! TOCOMPLETE - Put here the OASIS call to receive FRECVOCN (field2_recv)
+    ! Let's suppose here that FRECVOCN contains BC needed for the timestep
+    !
+    ! Here the model computes its timestep
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field1_send,ib)
+    !
+    ! Send FSENDOCN
+    ! TOCOMPLETE - Put here the OASIS call to send FSENDOCN (field1_send)
+    ! to the atmosphere and to the file
+    !
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE (w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  ! TOCOMPLETE - Put here the OASIS call to terminate the coupling
+  !
+  CALL mpi_finalize(ierror)
+END PROGRAM MODEL1
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_TP
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_TP	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_TP	(revision 4775)
@@ -0,0 +1,346 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+!
+PROGRAM model1
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER   :: data_filename='grid_model1.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model1'
+  CHARACTER(len=128) :: comp_out ! name of the output log file 
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc             ! number of corners
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat ! lon, lat of the points
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla ! lon, lat of the corners
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf ! surface of the grid meshes
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point  
+  !
+  INTEGER :: mype, npes ! rank and  number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FSENDOCN' ! 8 characters field sent by model1 to model2
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FRECVOCN' ! 8 characters field received by model1 from model2
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 6 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 3600       ! time step
+  !
+  INTEGER                 :: il_flag  ! Flag for grid writing by proc 0
+  !
+  INTEGER                 :: itap_sec ! Time used in oasis_put/get
+  !
+  ! Grid parameters definition
+  INTEGER                 :: part_id  ! use to connect the partition to the variables
+                                      ! in oasis_def_var
+  INTEGER                 :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                 ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_send(:,:)
+  REAL (kind=wp), POINTER :: field2_recv(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'oasis_init_comp abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id, comp_name,'Problem at line 98')
+  ENDIF
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 105')
+  ENDIF
+  !
+  w_unit = 100 + rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) 'MPI_COMM_WORLD is :',MPI_COMM_WORLD
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !      
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_get_localcomm ( localComm, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_get_localcomm abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 124')
+  ENDIF
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 131')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 137')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), ' ', 'comp', comp_id, 'local rank', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  WRITE (w_unit,*) 'Local communicator :', localComm
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grid netcdf file
+  !
+  ! Reading dimensions of the global grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the global grid
+  CALL read_grid(nlon,nlat,nc, data_filename, w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS3
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS3 convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      CALL oasis_start_grids_writing(il_flag)
+      CALL oasis_write_grid('torc', nlon, nlat, globalgrid_lon, globalgrid_lat)
+      CALL oasis_write_corner('torc', nlon, nlat, 4, globalgrid_clo, globalgrid_cla)
+      call oasis_write_area('torc', nlon, nlat, globalgrid_srf)
+      CALL oasis_write_mask('torc', nlon, nlat, indice_mask(:,:))
+      CALL oasis_terminate_grids_writing()
+  ENDIF
+  WRITE(w_unit,*) 'After grids writing'
+  call flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  CALL oasis_def_partition (part_id, il_paral, ierror)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!! !!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !  Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  !
+  ! Declaration of the field associated with the partition
+  CALL oasis_def_var (var_id(1),var_name1, part_id, &
+     var_nodims, OASIS_Out, var_actual_shape, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 243')
+  ENDIF
+  !
+  CALL oasis_def_var (var_id(2),var_name2, part_id, &
+     var_nodims, OASIS_In, var_actual_shape, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 250')
+  ENDIF
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_enddef ( ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_enddef abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 265')
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  !
+  ALLOCATE(field1_send(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_send'
+  !
+  ALLOCATE(field2_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_recv'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!! 
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange 
+  ! 
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    ! Get FRECVOCN
+    field2_recv=field_ini
+    CALL oasis_get(var_id(2),itap_sec, field2_recv, ierror)
+    write(w_unit,*) 'tcx recvf2 ',itap_sec,minval(field2_recv),maxval(field2_recv)
+    IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Recvd) THEN
+        WRITE (w_unit,*) 'oasis_get abort by model1 compid ',comp_id
+        CALL oasis_abort(comp_id,comp_name,'Problem at line 309')
+    ENDIF
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field1_send,ib)
+    !
+    ! Send FSENDOCN
+    write(w_unit,*) 'tcx sendf1 ',itap_sec,minval(field1_send),maxval(field1_send)
+    CALL oasis_put(var_id(1),itap_sec, field1_send, ierror)
+    IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Sent) THEN
+      WRITE (w_unit,*) 'oasis_put abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 320')
+    ENDIF
+    !
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE (w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  CALL oasis_terminate (ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_terminate abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 341')
+  ENDIF
+  !
+END PROGRAM MODEL1
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_monoonly
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_monoonly	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model1.F90_monoonly	(revision 4775)
@@ -0,0 +1,306 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+!
+PROGRAM model1
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER   :: data_filename='grid_model1.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model1'
+  CHARACTER(len=128) :: comp_out ! name of the output log file 
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc             ! number of corners
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat ! lon, lat of the points
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla ! lon, lat of the corners
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf ! surface of the grid meshes
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point  
+  !
+  INTEGER :: mype, npes ! rank and  number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FSENDOCN' ! 8 characters field sent by model1 to model2
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FRECVOCN' ! 8 characters field received by model1 from model2
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 6 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 3600       ! time step
+  !
+  !
+  INTEGER                 :: il_flag  ! Flag for grid writing by proc 0
+  !
+  INTEGER                 :: itap_sec ! Time used in oasis_put/get
+  !
+  ! Grid parameters definition
+  INTEGER                 :: part_id  ! use to connect the partition to the variables
+                                      ! in oasis_def_var
+  INTEGER                 :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                 ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_send(:,:)
+  REAL (kind=wp), POINTER :: field2_recv(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL MPI_Init(ierror)
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here OASIS initialisation call !
+  !
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 103')
+  ENDIF
+  !
+  w_unit = 100 + rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  localComm = MPI_COMM_WORLD
+  ! TOCOMPLETE - Put here OASIS call to get local MPI communicator !
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 126')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model1 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 132')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), 'local rank', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grid netcdf file
+  !
+  ! Reading dimensions of the global grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the global grid
+  CALL read_grid(nlon,nlat,nc, data_filename, w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+      !
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  !
+  ! TOCOMPLETE - Put here OASIS call to define local partition !
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!! !!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !  Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  !
+  ! Declaration of the field associated with the partition
+  !
+  ! TOCOMPLETE - Put here OASIS call to declare the coupling fields
+  !              FRECVOCN, FSENDOCN
+  ! var_name1 = 'FSENDOCN'
+  ! var_name2 = 'FRECVOCN'
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here the OASIS call to end the definition phase
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  !
+  ALLOCATE(field1_send(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_send'
+  !
+  ALLOCATE(field2_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_recv'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!! 
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=1 ; indj_end=nlat 
+  !
+  ! Data exchange 
+  ! 
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    ! Get FRECVOCN 
+    ! TOCOMPLETE - Put here the OASIS call to receive FRECVOCN (field2_recv)
+    ! Let's suppose here that FRECVOCN contains BC needed for the timestep
+    !
+    ! Here the model computes its timestep
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field1_send,ib)
+    !
+    ! Send FSENDOCN
+    ! TOCOMPLETE - Put here the OASIS call to send FSENDOCN (field1_send)
+    ! to the atmosphere and to the file
+    !
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE (w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  ! TOCOMPLETE - Put here the OASIS call to terminate the coupling
+  !
+  CALL mpi_finalize(ierror)
+END PROGRAM MODEL1
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90	(revision 4775)
@@ -0,0 +1,312 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+PROGRAM model2
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER :: data_filename='grid_model2.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model2'
+  CHARACTER(len=128) :: comp_out ! name of the output log file
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc ! number of corners in the (i,j) plan
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point 
+  !
+  INTEGER :: mype, npes ! rank and number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FRECVATM' ! 8 characters field received by the atmosphere from the ocean
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FSENDATM' ! 8 characters field sent by the atmosphere to the ocean
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 12 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 1800       ! time step
+  !
+  INTEGER                :: il_flag          ! Flag for grid writing
+  !
+  INTEGER                :: itap_sec ! Time
+  !
+  ! Grid parameter definition
+  INTEGER                :: part_id  ! use to connect the partition to the variables
+                                     ! in oasis_def_var
+  INTEGER                :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_recv(:,:)
+  REAL (kind=wp), POINTER :: field2_send(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL MPI_Init(ierror)
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here OASIS initialisation call !
+  !
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 102')
+  ENDIF
+  !
+  w_unit=100+rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  localComm = MPI_COMM_WORLD
+  ! TOCOMPLETE - Put here OASIS call to get local MPI communicator !
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 127')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 133')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), ' local rank ', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading netcdf file with pre-defined variable names
+  !
+  ! Reading dimensions of the grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the grid
+  CALL read_grid(nlon,nlat,nc,data_filename,w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in 
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+      !
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  !
+  ! TOCOMPLETE - Put here OASIS call to define local partition !
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  ! Declaration of the field associated with the partition of the grid
+  !
+  ! TOCOMPLETE - Put here OASIS call to declare the 2 coupling field
+  !              FRECVATM, FSENDATM !
+  ! var_name1 = 'FRECVATM'
+  ! var_name2 = 'FSENDATM'
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here the OASIS call to end the definition phase
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  ALLOCATE(field1_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_recv'
+  !
+  ALLOCATE(field2_send(var_actual_shape(2), var_actual_shape(4)),STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_send'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange
+  !
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    !
+    ! Get the field FRECVATM
+    field1_recv=field_ini
+    ! TOCOMPLETE - Put here the OASIS call to receive FRECVATM (field1_recv)
+    ! Let's suppose here that FRECVATM contains BC needed for the timestep
+    !
+    ! Here the model computes its timestep
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field2_send,ib)
+    !
+    ! Send the field FSENDATM
+    ! TOCOMPLETE - Put here the OASIS call to send FSENDATM (field2_send)
+    !
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  ! TOCOMPLETE - Put here the OASIS call to terminate the coupling
+  !
+  !
+  call mpi_finalize(ierror)
+END PROGRAM MODEL2
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_TP
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_TP	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_TP	(revision 4775)
@@ -0,0 +1,344 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+PROGRAM model2
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER :: data_filename='grid_model2.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model2'
+  CHARACTER(len=128) :: comp_out ! name of the output log file
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc ! number of corners in the (i,j) plan
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point 
+  !
+  INTEGER :: mype, npes ! rank and number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FRECVATM' ! 8 characters field received by the atmosphere from the ocean
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FSENDATM' ! 8 characters field sent by the atmosphere to the ocean
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 12 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 1800       ! time step
+  !
+  INTEGER                :: il_flag          ! Flag for grid writing
+  !
+  INTEGER                :: itap_sec ! Time
+  !
+  ! Grid parameter definition
+  INTEGER                :: part_id  ! use to connect the partition to the variables
+                                     ! in oasis_def_var
+  INTEGER                :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_recv(:,:)
+  REAL (kind=wp), POINTER :: field2_send(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'oasis_init_comp abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 98')
+  ENDIF
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 105')
+  ENDIF
+  !
+  w_unit = 100 + rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) 'MPI_COMM_WORLD is :',MPI_COMM_WORLD
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !  
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_get_localcomm ( localComm, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_get_localcomm abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 125')
+  ENDIF
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 132')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 138')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), ' ', 'comp', comp_id, 'local rank', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  WRITE (w_unit,*) 'Local communicator :', localComm
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading netcdf file with pre-defined variable names
+  !
+  ! Reading dimensions of the grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the grid
+  CALL read_grid(nlon,nlat,nc,data_filename,w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS3
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in 
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS3 convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      CALL oasis_start_grids_writing(il_flag)
+      CALL oasis_write_grid('lmdz', nlon, nlat, globalgrid_lon, globalgrid_lat)
+      CALL oasis_write_corner('lmdz', nlon, nlat, 4, globalgrid_clo, globalgrid_cla)
+      call oasis_write_area('lmdz', nlon, nlat, globalgrid_srf)
+      CALL oasis_write_mask('lmdz', nlon, nlat, indice_mask(:,:))
+      CALL oasis_terminate_grids_writing()
+  ENDIF
+  WRITE(w_unit,*) 'After grids writing'
+  call flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  CALL oasis_def_partition (part_id, il_paral, ierror)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  ! Declaration of the field associated with the partition of the grid
+  CALL oasis_def_var (var_id(1),var_name1, part_id, &
+     var_nodims, OASIS_In, var_actual_shape, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 242')
+  ENDIF
+  !
+  CALL oasis_def_var (var_id(2),var_name2, part_id, &
+     var_nodims, OASIS_Out, var_actual_shape, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_def_var abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 249')
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  CALL oasis_enddef ( ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_enddef abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 263')
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  ALLOCATE(field1_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_recv'
+  !
+  ALLOCATE(field2_send(var_actual_shape(2), var_actual_shape(4)),STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_send'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=((nlat/npes)*mype)+1 
+  !
+  IF (mype .LT. npes - 1) THEN
+      indj_end = (nlat/npes)*(mype+1)
+  ELSE
+      indj_end = nlat 
+  ENDIF
+  !
+  ! Data exchange
+  !
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    ! Get the field FRECVATM
+    field1_recv=field_ini
+    CALL oasis_get(var_id(1),itap_sec, field1_recv, ierror)
+    write(w_unit,*) 'tcx recvf1 ',itap_sec,minval(field1_recv),maxval(field1_recv)
+    IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Recvd) THEN
+        WRITE (w_unit,*) 'oasis_get abort by model2 compid ',comp_id
+        CALL oasis_abort(comp_id,comp_name,'Problem at line 306')
+    ENDIF
+    !
+    ! Send the field FSENDATM
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field2_send,ib)
+
+    !		       
+    write(w_unit,*) 'tcx sendf2 ',itap_sec,minval(field2_send),maxval(field2_send)
+    CALL oasis_put(var_id(2),itap_sec, field2_send, ierror)
+    IF ( ierror .NE. OASIS_Ok .AND. ierror .LT. OASIS_Sent) THEN
+        WRITE (w_unit,*) 'oasis_put abort by model2 compid ',comp_id
+        CALL oasis_abort(comp_id,comp_name,'Problem at line 317')
+    ENDIF
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  CALL oasis_terminate (ierror)
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'oasis_terminate abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 337')
+  ENDIF
+  !
+END PROGRAM MODEL2
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_monoonly
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_monoonly	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/model2.F90_monoonly	(revision 4775)
@@ -0,0 +1,306 @@
+!------------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+PROGRAM model2
+  !
+  ! Use for netCDF library
+  USE netcdf
+  ! Use for OASIS communication library
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+
+  INCLUDE 'mpif.h'
+
+  !
+  ! By default OASIS3 exchanges data in double precision.
+  ! To exchange data in single precision with OASIS3, 
+  ! the coupler has to be compiled with CPP key "use_realtype_single" 
+  ! and the model with CPP key "NO_USE_DOUBLE_PRECISION"
+#ifdef NO_USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(6,37)   ! real
+#elif USE_DOUBLE_PRECISION
+  INTEGER, PARAMETER :: wp = SELECTED_REAL_KIND(12,307) ! double
+#endif
+  !
+  CHARACTER(len=30), PARAMETER :: data_filename='grid_model2.nc'
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'model2'
+  CHARACTER(len=128) :: comp_out ! name of the output log file
+  CHARACTER(len=3)   :: chout
+  !
+  ! Global grid parameters : 
+  INTEGER :: nlon, nlat     ! dimensions in the 2 directions of space
+  INTEGER :: ntot           ! total dimension
+  INTEGER :: il_paral_size
+  INTEGER :: nc ! number of corners in the (i,j) plan
+  INTEGER :: indi_beg, indi_end, indj_beg, indj_end
+  !
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_lon,globalgrid_lat
+  DOUBLE PRECISION, DIMENSION(:,:,:), POINTER :: globalgrid_clo,globalgrid_cla
+  DOUBLE PRECISION, DIMENSION(:,:), POINTER   :: globalgrid_srf
+  INTEGER, DIMENSION(:,:), POINTER            :: indice_mask ! mask, 0 == valid point, 1 == masked point 
+  !
+  INTEGER :: mype, npes ! rank and number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER, DIMENSION(:), ALLOCATABLE :: il_paral ! Decomposition for each proc
+  !
+  INTEGER :: ierror, rank, w_unit
+  INTEGER :: i, j
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), PARAMETER :: var_name1 = 'FRECVATM' ! 8 characters field received by the atmosphere from the ocean
+  CHARACTER(len=8), PARAMETER :: var_name2 = 'FSENDATM' ! 8 characters field sent by the atmosphere to the ocean
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                   :: var_id(2) 
+  INTEGER                   :: var_nodims(2) 
+  INTEGER                   :: var_type
+  !
+  REAL (kind=wp), PARAMETER :: field_ini = -1. ! initialisation of received fields
+  !
+  INTEGER               ::  ib
+  INTEGER, PARAMETER    ::  il_nb_time_steps = 12 ! number of time steps
+  INTEGER, PARAMETER    ::  delta_t = 1800       ! time step
+  !
+  INTEGER                :: il_flag          ! Flag for grid writing
+  !
+  INTEGER                :: itap_sec ! Time
+  !
+  ! Grid parameter definition
+  INTEGER                :: part_id  ! use to connect the partition to the variables
+                                     ! in oasis_def_var
+  INTEGER                :: var_actual_shape(4) ! local dimensions of the arrays to the pe
+                                                ! 2 x field rank (= 4 because fields are of rank = 2)
+  !
+  ! Exchanged local fields arrays
+  ! used in routines oasis_put and oasis_get
+  REAL (kind=wp), POINTER :: field1_recv(:,:)
+  REAL (kind=wp), POINTER :: field2_send(:,:)
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !   INITIALISATION
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL MPI_Init(ierror)
+  !!!!!!!!!!!!!!!!! OASIS_INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here OASIS initialisation call !
+  !
+  !
+  ! Unit for output messages : one file for each process
+  CALL MPI_Comm_Rank ( MPI_COMM_WORLD, rank, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 102')
+  ENDIF
+  !
+  w_unit=100+rank
+  WRITE(chout,'(I3)') w_unit
+  comp_out=comp_name//'.out_'//chout
+  !
+  OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  WRITE (w_unit,*) '-----------------------------------------------------------'
+  WRITE (w_unit,*) TRIM(comp_name), ' Running with reals compiled as kind =',wp
+  WRITE (w_unit,*) 'I am component ', TRIM(comp_name), ' rank :',rank
+  WRITE (w_unit,*) '----------------------------------------------------------'
+  CALL flush(w_unit)
+  !
+  !!!!!!!!!!!!!!!!! OASIS_GET_LOCALCOMM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  localComm = MPI_COMM_WORLD
+  ! TOCOMPLETE - Put here OASIS call to get local MPI communicator !
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'MPI_comm_size abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 127')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (w_unit,*) 'MPI_Comm_Rank abort by model2 compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at line 133')
+  ENDIF
+  !
+  WRITE(w_unit,*) 'I am the ', TRIM(comp_name), ' local rank ', mype
+  WRITE (w_unit,*) 'Number of processors :',npes
+  CALL flush(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading netcdf file with pre-defined variable names
+  !
+  ! Reading dimensions of the grid
+  CALL read_dimgrid(nlon,nlat,data_filename,w_unit)
+  nc=4
+  !
+  ! Allocation
+  ALLOCATE(globalgrid_lon(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lon'
+  ALLOCATE(globalgrid_lat(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_lat'
+  ALLOCATE(globalgrid_clo(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_clo'
+  ALLOCATE(globalgrid_cla(nlon,nlat,nc), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_cla'
+  ALLOCATE(globalgrid_srf(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating globalgrid_srf'
+  ALLOCATE(indice_mask(nlon,nlat), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating indice_mask'
+  !
+  ! Reading of the longitudes, latitudes, longitude and latitudes of the corners, mask of the grid
+  CALL read_grid(nlon,nlat,nc,data_filename,w_unit, &
+                 globalgrid_lon,globalgrid_lat, &
+                 globalgrid_clo,globalgrid_cla, &
+                 globalgrid_srf, &
+                 indice_mask)
+  !
+  ! (Global) grid definition for OASIS
+  ! Writing of the file grids.nc and masks.nc by the processor 0 from the grid read in 
+  !
+  IF (mype == 0) THEN
+      !
+      ! Mask inversion to follow (historical) OASIS convention (0=not masked;1=masked)
+      WHERE(indice_mask == 1) 
+          indice_mask=0
+      ELSEWHERE
+          indice_mask=1
+      END WHERE
+      !
+      ! TOCOMPLETE - Put here OASIS grid, corner, areas and mask writing calls !
+      !
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  ! Definition of the partition of the grid (calling oasis_def_partition)
+  ntot=nlon*nlat
+#ifdef DECOMP_APPLE
+  il_paral_size = 3
+#elif defined DECOMP_BOX
+  il_paral_size = 5
+#endif
+  ALLOCATE(il_paral(il_paral_size))
+  WRITE(w_unit,*) 'After allocate il_paral, il_paral_size', il_paral_size
+  call flush(w_unit)
+  !
+  CALL decomp_def (il_paral,il_paral_size,nlon,nlat,mype,npes,w_unit)
+  WRITE(w_unit,*) 'After decomp_def, il_paral = ', il_paral(:)
+  call flush(w_unit)
+  !
+  ! TOCOMPLETE - Put here OASIS call to define local partition !
+  ! The data are exchanged in the global grid so you do not need to pass 
+  ! isize to oasis_def_partition
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! DEFINITION OF THE LOCAL FIELDS  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_DEF_VAR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Define transient variables
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_actual_shape(1) = 1
+  var_actual_shape(2) = il_paral(3)
+  var_actual_shape(3) = 1 
+#ifdef DECOMP_APPLE
+  var_actual_shape(4) = 1
+#elif defined DECOMP_BOX
+  var_actual_shape(4) = il_paral(4)
+#endif
+  ! Declaration of the field associated with the partition of the grid
+  !
+  ! TOCOMPLETE - Put here OASIS call to declare the 2 coupling field
+  !              FRECVATM, FSENDATM !
+  ! var_name1 = 'FRECVATM'
+  ! var_name2 = 'FSENDATM'
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  All processes involved in the coupling must call oasis_enddef; 
+  !  here all processes are involved in coupling
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_ENDDEF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! TOCOMPLETE - Put here the OASIS call to end the definition phase
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! SEND AND RECEIVE ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model
+  !
+  ALLOCATE(field1_recv(var_actual_shape(2), var_actual_shape(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field1_recv'
+  !
+  ALLOCATE(field2_send(var_actual_shape(2), var_actual_shape(4)),STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field2_send'
+  !
+  DEALLOCATE(il_paral)
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!OASIS_PUT/OASIS_GET !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  indi_beg=1 ; indi_end=nlon
+  indj_beg=1 ; indj_end=nlat  
+  !
+  ! Data exchange
+  !
+  ! Time loop
+  DO ib=1, il_nb_time_steps
+    itap_sec = delta_t * (ib-1) ! Time
+    !
+    !
+    ! Get the field FRECVATM
+    field1_recv=field_ini
+    ! TOCOMPLETE - Put here the OASIS call to receive FRECVATM (field1_recv)
+    ! Let's suppose here that FRECVATM contains BC needed for the timestep
+    !
+    ! Here the model computes its timestep
+    !
+    CALL function_sent(var_actual_shape(2), var_actual_shape(4), &
+                       RESHAPE(globalgrid_lon(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                       RESHAPE(globalgrid_lat(indi_beg:indi_end,indj_beg:indj_end),&
+                               (/ var_actual_shape(2), var_actual_shape(4) /)), &
+                                field2_send,ib)
+    !
+    ! Send the field FSENDATM
+    ! TOCOMPLETE - Put here the OASIS call to send FSENDATM (field2_send)
+    !
+    !
+  ENDDO
+  !
+  WRITE (w_unit,*) 'End of the program'
+  CALL flush(w_unit)
+  CLOSE(w_unit)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  !!!!!!!!!!!!!!!!!! OASIS_TERMINATE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! Collective call to terminate the coupling exchanges
+  !
+  ! TOCOMPLETE - Put here the OASIS call to terminate the coupling
+  !
+  !
+  call mpi_finalize(ierror)
+END PROGRAM MODEL2
+!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_dimgrid.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_dimgrid.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_dimgrid.F90	(revision 4775)
@@ -0,0 +1,69 @@
+!****************************************************************************************
+SUBROUTINE read_dimgrid (nlon,nlat,data_filename,w_unit)
+  !**************************************************************************************
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit
+  !
+  INTEGER                  :: il_file_id,il_grid_id,il_lon_id, &
+     il_lat_id,il_indice_id, &
+     lon_dims,lat_dims,imask_dims
+  !
+  INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: lon_dims_ids,lat_dims_ids,&
+     imask_dims_ids,lon_dims_len,&
+     lat_dims_len,imask_dims_len  
+  !               
+  INTEGER, INTENT(out)     :: nlon,nlat
+  !
+  CHARACTER(len=30)        :: data_filename
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'lon' ,  il_lon_id),    __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'lat' ,  il_lat_id),    __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'imask', il_indice_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(il_file_id, varid=il_lon_id, ndims=lon_dims, dimids=lon_dims_ids), __LINE__ )
+  !
+  ! The value lon_dims_len(i) is obtained thanks to the lon_dims_ids ID already obtained from the file
+  DO i=1,lon_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lon_dims_ids(i),len=lon_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  nlon=lon_dims_len(1)
+  nlat=lon_dims_len(2)
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(ncid=il_file_id, varid=il_lat_id, ndims=lat_dims, dimids=lat_dims_ids), __LINE__ )
+  !
+  ! The value lat_dims_len(i) is obtained thanks to the lat_dims_ids ID already obtained from the file
+  DO i=1,lat_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=lat_dims_ids(i),len=lat_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  IF ( (lat_dims_len(1) .NE. lon_dims_len(1)).OR.(lat_dims_len(2) .NE. lon_dims_len(2)) ) THEN
+      WRITE(w_unit,*) 'Problem model1 in read_dimgrid'
+      WRITE(w_unit,*) 'Dimensions of the latitude are not the same as the ones of the longitude'
+      CALL flush(w_unit)
+      STOP
+  ENDIF
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL hdlerr( NF90_INQUIRE_VARIABLE(ncid=il_file_id, varid=il_indice_id, ndims=imask_dims, dimids=imask_dims_ids), __LINE__ )
+  !
+  ! The value imask_dims_len(i) is obtained thanks to the imask_dims_ids ID already obtained from the file
+  DO i=1,imask_dims
+    CALL hdlerr( NF90_INQUIRE_DIMENSION(ncid=il_file_id,dimid=imask_dims_ids(i),len=imask_dims_len(i)), __LINE__ )
+  ENDDO
+  !
+  CALL hdlerr(NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  WRITE(w_unit,*) 'Reading input file ',data_filename
+  WRITE(w_unit,*) 'Global dimensions nlon=',nlon,' nlat=',nlat
+  CALL flush(w_unit)
+  !
+  !
+END SUBROUTINE read_dimgrid
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_grid.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_grid.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/read_grid.F90	(revision 4775)
@@ -0,0 +1,98 @@
+  !****************************************************************************************
+  SUBROUTINE read_grid (nlon,nlat,corners_ij_lus, &
+                                       data_filename, w_unit, &
+                                       gridlon,gridlat, &
+                                       gridclo,gridcla, &
+                                       gridsrf, &
+                                       indice_mask)
+  !**************************************************************************************
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER                  :: i,j,k,w_unit
+  !
+  INTEGER                  :: il_file_id,il_grid_id,il_lon_id, &
+                              il_lat_id,il_clo_id,il_cla_id,il_srf_id,il_indice_id, &
+                              lon_dims,lat_dims,clo_dims,cla_dims,&
+                              imask_dims
+  !
+  INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: lon_dims_ids,lat_dims_ids,clo_dims_ids,&
+                                           cla_dims_ids,imask_dims_ids,lon_dims_len,&
+                                           lat_dims_len,clo_dims_len,cla_dims_len,&
+                                           imask_dims_len  
+  !               
+  INTEGER, INTENT(in)     :: nlon,nlat,corners_ij_lus
+  !
+  CHARACTER(len=30)        :: data_filename
+  !
+  INTEGER,  DIMENSION(3)   :: ila_dim
+  INTEGER,  DIMENSION(3)   :: ila_corners,ila_what
+  !
+  DOUBLE PRECISION, DIMENSION(nlon,nlat)                :: gridlon,gridlat,gridsrf
+  DOUBLE PRECISION, DIMENSION(nlon,nlat,corners_ij_lus) :: gridclo,gridcla
+  INTEGER, DIMENSION(nlon,nlat)                      :: indice_mask
+  !
+  !
+  ! Dimensions
+  !
+  CALL hdlerr(NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  !
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'lon' , il_lon_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'lat' , il_lat_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'clo' , il_clo_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'cla' , il_cla_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'srf' , il_srf_id), __LINE__ )
+  CALL hdlerr( NF90_INQ_VARID(il_file_id, 'imask' , il_indice_id), __LINE__ )
+  !
+  ila_what(:)=1
+  !
+  ila_dim(1)=nlon
+  ila_dim(2)=nlat
+  ila_dim(3)=1
+  !
+  ila_corners(1)=nlon
+  ila_corners(2)=nlat
+  ila_corners(3)=corners_ij_lus
+  !
+  ! Data
+  !
+  CALL hdlerr( NF90_OPEN(data_filename, NF90_NOWRITE, il_file_id), __LINE__ )
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lon_id, gridlon, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global grid longitudes reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_lat_id, gridlat, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global grid latitudes reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR(il_file_id, il_clo_id, gridclo, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global grid longitude corners reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_cla_id, gridcla, &
+     ila_what, ila_corners), __LINE__ )
+  WRITE(w_unit,*) 'Global grid latitude corners reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_srf_id, gridsrf, &
+     ila_what(1:2), ila_dim(1:2)), __LINE__ )
+  WRITE(w_unit,*) 'Global grid surfaces reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_GET_VAR (il_file_id, il_indice_id, indice_mask, &
+     ila_what, ila_dim), __LINE__ )
+  WRITE(w_unit,*) 'Global grid mask reading done'
+  CALL flush(w_unit)
+  !
+  CALL hdlerr( NF90_CLOSE(il_file_id), __LINE__ )
+  !
+  WRITE(w_unit,*) 'End of routine read_grid'
+  CALL flush(w_unit)
+  !
+END SUBROUTINE read_grid
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/routine_hdlerr.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/routine_hdlerr.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/routine_hdlerr.F90	(revision 4775)
@@ -0,0 +1,21 @@
+!*********************************************************************************
+SUBROUTINE hdlerr(istatus, line)
+  !*********************************************************************************
+  use netcdf
+  implicit none
+  !
+  INCLUDE 'mpif.h'
+  !
+  ! Check for error message from NetCDF call
+  !
+  integer, intent(in) :: istatus, line
+  integer             :: ierror
+  !
+  IF (istatus .NE. NF90_NOERR) THEN
+      write ( * , * ) 'NetCDF problem at line',line
+      write ( * , * ) 'Stopped '
+      call MPI_Abort ( MPI_COMM_WORLD, 1, ierror )
+  ENDIF
+  !
+  RETURN
+END SUBROUTINE hdlerr
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/run_tutorial
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/run_tutorial	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/examples/tutorial/run_tutorial	(revision 4775)
@@ -0,0 +1,396 @@
+#!/bin/ksh
+#set -x
+######################################################################
+#
+host=`uname -n`
+user=`whoami`
+#
+## - Define paths
+srcdir=`pwd`
+datadir=$srcdir/data_oasis3
+casename=`basename $srcdir`
+#
+## - Name of the executables
+    exe1=model1
+    exe2=model2
+#
+############### User's section #######################################
+#
+## - Define architecture and coupler 
+arch=tioman_pgi_mpich   #tioman_pgi_mpich/corail/curie(CEA)/jade/training_computer/ubuntu
+                        #crayXE6, beaufix, ada 
+#
+# - Define number of processes to run each executable
+    nproc_exe1=1
+    nproc_exe2=1
+#
+## - Define rundir
+if [ ${arch} == tioman_pgi_mpich ] || [ ${arch} == training_computer ]; then
+    MPIRUN=/usr/local/pgi/linux86-64/2011/mpi/mpich/bin/mpirun
+    rundir=${HOME}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == tioman_intel_openmpi ]; then
+    MPIRUN=/usr/local_intel12/openmpi143/bin/mpirun
+    rundir=${HOME}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == corail ]; then
+rundir=/lustre/globc/${user}/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == curie ]; then
+    rundir=/ccc/work/cont005/pa0490/coquartl/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == jade ]; then
+    rundir=/data/11coqu/oasis3-mct/examples/${casename}/work_${casename}
+elif [ ${arch} == neptune_gfortran ]; then
+    rundir=/scratch/globc/coquart/oasis3-mct_buildbot/examples/${casename}/work_${casename}
+elif [ ${arch} == ubuntu ]; then 
+  MPIRUN=mpirun
+  rundir=${srcdir}/work_${casename}
+elif [ ${arch} == crayXE6 ]; then
+rundir=/zhome/academic/HLRS/imk/imkbreil/Programme/oasis/oasis3-mct/examples/tutorial/work_${casename}
+elif [ ${arch} == beaufix ]; then
+# The toy must be directly in the TMPDIRs the jobs can only run in the TMPDIR
+    rundir=/scratch/utmp/cglo355/oasis3-mct/examples/tutorial/work_${casename}
+elif [ ${arch} == ada ]; then
+  MPIRUN=/opt/intel/impi/4.1.0.024/intel64/bin/mpirun
+  rundir=/workgpfs/rech/ces/rces980/modBRETAGNE/oasis3-mct/examples/tutorial/work_${casename}
+fi
+#
+############### End of user's section ################################
+
+echo ''
+echo '*****************************************************************'
+echo '*** '$casename' : '$run
+echo ''
+echo 'Rundir       :' $rundir
+echo 'Architecture :' $arch
+echo 'Host         : '$host
+echo 'User         : '$user
+echo ''
+echo $exe1' runs on '$nproc_exe1 'processes'
+echo $exe2' runs on '$nproc_exe2 'processes'
+echo ''
+echo ''
+######################################################################
+###
+### 1. Copy source example directory containing everything needed
+###    into rundir
+
+\rm -fr $rundir
+mkdir -p $rundir
+
+cp -f $datadir/*nc  $rundir/.
+cp -f $datadir/*.jnl $rundir/.
+
+cp -f $srcdir/$exe1 $rundir/.
+cp -f $srcdir/$exe2 $rundir/.
+
+cp -f $datadir/namcouple $rundir/.
+#
+cd $rundir
+#
+######################################################################
+###
+### 3. Creation of configuration scripts
+
+###---------------------------------------------------------------------
+### Linux
+###---------------------------------------------------------------------
+
+if [ $arch == tioman_pgi_mpich ] || [ $arch == training_computer ]; then
+if [ $nproc_exe1 == 1 ]; then
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 0 $rundir/$exe1
+EOF
+else
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 0 $rundir/$exe1
+EOF
+
+  count=1
+  while [[ $count -lt $nproc_exe1 ]];do
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 1 $rundir/$exe1
+EOF
+   (( count += 1 ))
+  done
+fi
+
+  count=0
+  while [[ $count -lt $nproc_exe2 ]];do
+   cat <<EOF >> $rundir/appl-linux.conf
+$host 1 $rundir/$exe2
+EOF
+   (( count += 1 ))
+  done
+
+###---------------------------------------------------------------------
+### CORAIL
+###---------------------------------------------------------------------
+elif [ $arch == corail ] ; then
+
+  cat <<EOF > $rundir/run_$casename.$arch
+# Nom du job
+#PBS -N ${casename}
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l select=1:mpiprocs=24:ncpus=24
+#PBS -l place=scatter:excl
+# adresse email a utiliser
+##PBS -M your_email
+# Mail envoye a la fin du job
+#PBS -m ae
+
+cd $rundir
+
+source /usr/local/bin/intelmpi.sh
+ulimit -s unlimited
+#
+#
+time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### BEAUFIX
+###---------------------------------------------------------------------
+elif [ $arch == beaufix ] ; then
+
+   (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/bash
+#SBATCH --time=01:00:00
+#SBATCH -p  normal32        # partition/queue
+#SBATCH --job-name=toys     # job name
+#SBATCH -N 1                # number of nodes
+#SBATCH -n $nproc                # number of procs
+#SBATCH -o job.out%j
+#SBATCH -o job.err%j
+#SBATCH --exclusive
+
+ulimit -s unlimited
+# rundir must be in the TMPDIR
+cd $rundir
+module load intel/13.1.4.183
+module load intelmpi/4.1.1.036
+module load netcdf/4.3.0 
+#
+#
+# Activate next line to run in coupled mode
+#time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+# Activate next two lines to run both models stand alone
+time mpirun -np $nproc_exe1 ./$exe1
+time mpirun -np $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### NEPTUNE
+###---------------------------------------------------------------------
+elif [ $arch == neptune_gfortran ] ; then
+
+  cat <<EOF > $rundir/run_$casename.$arch
+# Nom du job
+#PBS -N tests
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l select=1:mpiprocs=16:ncpus=16
+#PBS -l place=scatter:excl
+
+cd $rundir
+
+export LD_LIBRARY_PATH=/usr/lib64:$LD_LIBRARY_PATH
+ulimit -s unlimited
+#
+#
+time mpirun -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2
+#
+EOF
+
+
+###---------------------------------------------------------------------
+### CURIE (normal nodes)
+###---------------------------------------------------------------------
+elif [ $arch == curie ] ; then
+
+   cat <<EOF > $rundir/appl-curie.conf
+$nproc_exe1 $rundir/$exe1
+$nproc_exe2 $rundir/$exe2
+EOF
+
+      (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/bash
+#MSUB -r test_interp # Request name
+#MSUB -n $nproc # Number of tasks to use
+#MSUB -T 3600 # Elapsed time limit in seconds
+#MSUB -o $casename_%I.o # Standard output. %I is the job id
+#MSUB -e $casename_%I.e # Error output. %I is the job id
+#MSUB -A gen6028 # Project ID
+set -x
+cd $rundir
+ccc_mprun -f appl-curie.conf
+EOF
+
+###-----------------------------------------------------------------
+### JADE - CINES
+###-----------------------------------------------------------------
+elif [ $arch == jade ] ; then
+(( NNODE = (  $nproc_exe1 + $nproc_exe2 ) / 8 ))
+(( RESTE = (  $nproc_exe1 + $nproc_exe2 ) - ( $NNODE * 8 ) ))
+if [[ $RESTE -gt 0 ]]; then
+ (( NNODE = $NNODE + 1 ))
+fi
+
+echo $NNODE
+
+cat << EOF > $rundir/run_$casename.$arch
+#PBS -S /bin/bash
+#PBS -N OASIS
+#PBS -l walltime=00:10:00
+#PBS -l select=$NNODE:ncpus=8:mpiprocs=8
+#PBS -o $rundir/out
+#PBS -e $rundir/err
+#PBS -j oe
+#
+set -evx
+module load netcdf
+cd $rundir
+cat $PBS_NODEFILE
+## Lancement executable
+which mpiexec
+export MPI_GROUP_MAX=100
+time mpiexec -n $nproc_exe1 ./$exe1 : -n $nproc_exe2 ./$exe2 
+
+EOF
+
+###---------------------------------------------------------------------
+### CRAYXE6
+###---------------------------------------------------------------------
+elif [ $arch == crayXE6 ] ; then
+
+ (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+d_aus=lm_aus.log       # Ausgabe- u. Fehlerdateien
+d_err=lm_fehler.log
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/ksh
+# Nom du job
+#PBS -N ${casename}
+# Temps limite du job
+#PBS -l walltime=00:10:00
+# Nombre de processus
+#PBS -l mppwidth=$nproc
+#PBS -l mppnppn=1
+#PBS -l mppdepth=1
+#PBS -o $d_aus 
+#PBS -e $d_err
+#
+cd $rundir
+#
+ulimit -c unlimited
+export LIBDWD_FORCE_CONTROLWORDS=1
+export LIBDWD_BITMAP_TYPE=ASCII
+#
+#export MPICH_GNI_DYNAMIC_CONN=disabled
+export MPICH_ENV_DISPLAY=1
+export MPICH_GNI_MAX_EAGER_MSG_SIZE=64000
+export MPICH_ABORT_ON_ERROR=1
+export MALLOC_MMAP_MAX_=0
+export MALLOC_TRIM_THRESHOLD_=-1
+#
+aprun -n $nproc_exe1 ./$exe1 : -n $nproc_exe2 ./$exe2
+#
+EOF
+
+###---------------------------------------------------------------------
+### ada
+###---------------------------------------------------------------------
+elif [ $arch == ada ] ; then
+
+ (( nproc = $nproc_exe1 + $nproc_exe2 ))
+
+  cat <<EOF > $rundir/run_$casename.$arch
+#!/bin/ksh
+# ######################
+# ##   ADA IDRIS   ##
+# ######################
+# Nom de la requete
+# @ job_name = ${casename}
+# Type de travail
+# @ job_type = parallel
+# Fichier de sortie standard
+# @ output = Script_Output_${casename}.000001
+# Fichier de sortie erreur (le meme)
+# @ error = Script_Output_${casename}.000001
+# Nombre de processus demandes
+# @ total_tasks = ${nproc}
+# @ environment = "BATCH_NUM_PROC_TOT=32"
+# Temps CPU max. par processus MPI hh:mm:ss
+# @ wall_clock_limit = 0:30:00
+# Fin de l entete
+# @ queue
+#
+# pour avoir l'echo des commandes
+set -x
+
+# on se place dans le repertoire rundir
+cd ${rundir}
+
+module load netcdf
+module load hdf5
+
+#
+export KMP_STACKSIZE=64m
+export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/smplocal/pub/NetCDF/4.1.3/lib
+
+poe -pgmmodel MPMD -cmdfile run_file
+#
+EOF
+
+fi 
+
+######################################################################
+###
+### 4. Execute the model
+
+if [ $arch == tioman_pgi_mpich ] || [ $arch == training_computer ]; then
+    echo 'Executing the model using '$MPIRUN 
+#    $MPIRUN -p4pg appl-linux.conf ./$exe1 > runjob.err
+    $MPIRUN -np $nproc_exe1 ./$exe1 > runjob.err
+    $MPIRUN -np $nproc_exe2 ./$exe2 >> runjob.err 
+elif [ $arch == ubuntu ] || [ $arch == tioman_intel_openmpi ] ; then
+    echo 'Executing the model using '$MPIRUN 
+    $MPIRUN -np $nproc_exe1 ./$exe1 : -np $nproc_exe2 ./$exe2 > runjob.err
+elif [ $arch == corail ]; then
+    echo 'Submitting the job to queue using qsub'
+    qsub -q submit $rundir/run_$casename.$arch
+    qstat | grep $user
+elif [ $arch == beaufix ]; then
+    echo 'Submitting the job to queue using sbatch'
+    sbatch $rundir/run_$casename.$arch
+    squeue -u $user
+elif [ $arch == neptune_gfortran ]; then
+    echo 'Submitting the job to queue using qsub'
+    qsub $rundir/run_$casename.$arch
+    qstat | grep $user
+elif [ $arch == curie ]; then
+    ccc_msub $rundir/run_$casename.$arch
+    ccc_mpp | grep $user
+elif [ $arch == jade ] ; then
+    qsub $rundir/run_$casename.$arch
+    qstat -awu $user
+elif [ $arch == crayXE6 ]; then
+    echo 'Submitting the job to queue using qsub'
+    chmod u+x $rundir/run_$casename.$arch
+    qsub $rundir/run_$casename.$arch
+    qstat
+elif [ $arch == ada ]; then
+    echo 'Submitting the job to queue using llsubmit'
+    llsubmit $rundir/run_$casename.$arch
+fi
+echo $casename 'is executed or submitted to queue.'
+echo 'Results are found in rundir : '$rundir 
+
+######################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+Makefile.conf config.log config.status config.h autom4te.cache
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/COPYRIGHT
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/COPYRIGHT	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/COPYRIGHT	(revision 4775)
@@ -0,0 +1,51 @@
+                            Modeling Coupling Toolkit (MCT) Software
+
+Copyright © 2011, UChicago Argonne, LLC as Operator of Argonne National Laboratory.  
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, 
+are permitted provided that the following conditions are met:
+
+
+1. Redistributions of source code must retain the above copyright notice, this list of conditions 
+   and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions 
+   and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+3. The end-user documentation included with the redistribution, if any, must include the following 
+   acknowledgment:
+
+   "This product includes software developed by the UChicago Argonne, LLC, as Operator of Argonne 
+    National Laboratory." 
+
+   Alternately, this acknowledgment may appear in the software itself, if and wherever such third-party 
+   acknowledgments normally appear.
+
+This software was authored by:
+
+Argonne National Laboratory Climate Modeling Group
+Robert Jacob, tel: (630) 252-2983, E-mail: jacob@mcs.anl.gov
+Jay Larson, E-mail: larson@mcs.anl.gov
+Everest Ong
+Ray Loy
+Mathematics and Computer Science Division
+Argonne National Laboratory, Argonne IL 60439
+
+
+4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS" WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER,
+   THE UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND THEIR EMPLOYEES: (1) DISCLAIM ANY
+   WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES OF MERCHANTABILITY, 
+   FITNESS FOR A PARTICULAR PURPOSE, TITLE OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY OR 
+   RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT 
+   USE OF THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4) DO NOT WARRANT THAT THE SOFTWARE WILL 
+   FUNCTION UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL BE CORRECTED. 
+
+5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT HOLDER, THE UNITED STATES, THE UNITED STATES 
+   DEPARTMENT OF ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT, INCIDENTAL, CONSEQUENTIAL, SPECIAL 
+   OR PUNITIVE DAMAGES OF ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF PROFITS OR LOSS OF 
+   DATA, FOR ANY REASON WHATSOEVER, WHETHER SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT 
+   (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE, EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED 
+   OF THE POSSIBILITY OF SUCH LOSS OR DAMAGES.
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile	(revision 4775)
@@ -0,0 +1,33 @@
+
+SHELL = /bin/sh
+
+include Makefile.conf
+
+SUBDIRS = $(MPISERPATH) $(MPEUPATH) $(MCTPATH)
+
+# TARGETS
+subdirs:
+	@set -e; for dir in $(SUBDIRS); do \
+	  cd $$dir;                \
+	  $(MAKE);                 \
+	  cd $(abs_top_builddir);  \
+	done
+
+clean:
+	@set -e; for dir in $(SUBDIRS); do \
+	  cd $$dir;                \
+	  $(MAKE) clean;           \
+	  cd $(abs_top_builddir);  \
+	done
+
+install: subdirs
+	@set -e; for dir in $(SUBDIRS); do \
+	  cd $$dir;                \
+	  $(MAKE) install;         \
+	  cd $(abs_top_builddir);  \
+	done
+
+examples: subdirs
+	@cd $(EXAMPLEPATH) && $(MAKE)
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile.conf.in
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile.conf.in	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/Makefile.conf.in	(revision 4775)
@@ -0,0 +1,88 @@
+# Source location
+SRCDIR = @abs_srcdir@
+FDEPENDS=$(SRCDIR)/fdepends.awk
+
+# COMPILER, LIBRARY, AND MACHINE MAKE VARIABLES
+
+# FORTRAN COMPILER VARIABLES #
+
+# FORTRAN COMPILER COMMAND
+FC		= @MPIFC@
+
+# FORTRAN AND FORTRAN90 COMPILER FLAGS
+FCFLAGS		= @OPT@ @DEBUG@ @FCFLAGS@ @BIT64@
+
+FC_DEFINE = @FC_DEFINE@
+
+# FORTRAN COMPILE FLAG FOR AUTOPROMOTION 
+# OF NATIVE REAL TO 8 BIT REAL
+REAL8           = @REAL8@
+
+# FORTRAN COMPILE FLAGS FOR EXAMPLE PROGRAMS
+PROGFCFLAGS = @PROGFCFLAGS@
+
+# FORTRAN COMPILE FLAG FOR CHANGING BYTE ORDERING
+ENDIAN          = @ENDIAN@
+
+# INCLUDE FLAG FOR LOCATING MODULES (-I, -M, or -p)
+INCFLAG         = @INCLUDEFLAG@
+
+# INCLUDE PATHS (PREPEND INCLUDE FLAGS -I, -M or -p)
+INCPATH         = @INCLUDEPATH@ @MPIHEADER@
+
+# MPI LIBRARIES (USUALLY -lmpi)
+MPILIBS         = @MPILIBS@
+
+# PREPROCESSOR VARIABLES #
+
+# COMPILER AND OS DEFINE FLAGS
+CPPDEFS = @CPPDEFS@ 
+
+FPPDEFS=$(patsubst -D%,$(FC_DEFINE)%,$(CPPDEFS))
+
+# C COMPILER VARIABLES #
+
+# C COMPILER
+CC		= @CC@
+
+# C COMPILER FLAGS - APPEND CFLAGS
+CFLAGS       = @CFLAGS@ 
+CPPFLAGS = @CPPFLAGS@
+
+# LIBRARY SPECIFIC VARIABLES #
+
+# USED BY MCT BABEL BINDINGS
+COMPILER_ROOT = @COMPILER_ROOT@
+BABELROOT     = @BABELROOT@
+PYTHON        = @PYTHON@
+PYTHONOPTS    = @PYTHONOPTS@
+
+# USED BY MPI-SERIAL LIBRARY
+
+# SIZE OF FORTRAN REAL AND DOUBLE
+FORT_SIZE = @FORT_SIZE@
+
+
+# INSTALLATION VARIABLES #
+
+# INSTALL COMMANDS
+INSTALL         = @abs_top_builddir@/install-sh -c
+MKINSTALLDIRS   = @abs_top_builddir@/mkinstalldirs
+
+# INSTALLATION DIRECTORIES
+abs_top_builddir= @abs_top_builddir@
+MCTPATH         = @abs_top_builddir@/mct
+MPEUPATH        = @abs_top_builddir@/mpeu
+EXAMPLEPATH     = @abs_top_builddir@/examples
+MPISERPATH      = @MPISERPATH@
+libdir          = @prefix@/lib
+includedir      = @prefix@/include
+
+# OTHER COMMANDS #
+AR		= @AR@
+RM		= rm -f
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/README	(revision 4775)
@@ -0,0 +1,206 @@
+######################################################################
+
+ -- Mathematics + Computer Science Div. / Argonne National Laboratory
+
+    Model Coupling Toolkit (MCT)
+
+    Jay Larson
+    Robert Jacob
+    Everest Ong
+    Ray Loy
+	
+    For more information, see http://www.mcs.anl.gov/mct
+
+    See MCT/COPYRIGHT for license.
+
+######################################################################
+
+  This is version 2.8 of the Model Coupling Toolkit (MCT).
+
+  Our purpose in creating this toolkit is to support the construction
+  of highly portable and extensible high-performance couplers 
+  for distributed memory parallel coupled models.
+
+######################################################################
+
+
+  Current Contents of the directory MCT:
+
+  README   -- this file
+
+  COPYRIGHT - copyright statement and license.
+
+  mct/     -- Source code for the Model Coupling Toolkit.
+
+  mpeu/    -- Source code for the message-passing environment utilities
+              library (MPEU), which provides support for MCT 
+
+  mpi-serial/  -- Source code for optional mpi replacement library.
+
+  examples/-- Source code for examples which demonstrate the use of MCT.
+
+  doc/     -- documentation for MCT
+
+  protex/  -- tool for constructing documentation from source code
+
+  data/    -- input data for running example programs.  Not needed to
+              compile the library.
+
+  m4/      -- files for autoconf (not needed to build).
+
+Optional Contents available
+
+  babel/   -- multi language interface for MCT using BABEL.
+              See babel/README for more information.
+
+######################################################################
+  REQUIREMENTS:
+
+  Building MCT requires a Fortran90 compiler.
+
+  An MPI library is now optional.  To compile without MPI, add
+  --enable-mpiserial to the configure command below.  Note that
+  not all the examples will work without MPI.  See mpi-serial/README
+  for more information.
+
+
+  The MCT library builds and the examples run on the following
+  platforms/compilers:
+
+  Linux: Portland Group, Intel, gfortran, Absoft, Pathscale, Lahey, NAG
+  MacOSX: gfortran
+  IBM (AIX) xlf
+  IBM BlueGene (see PLATFORM NOTE below)
+  SGI Altix
+  Cray XT/XK
+  Compaq  Compaq Fortran Compiler (X5.5-2801-48CAG or later)
+  SUN (Solaris) f90 WorkShop
+  NEC
+  Fujitsu
+
+  Running some of the examples requires a parallel platform.
+  Memory requirements are modest.
+
+######################################################################
+  BUILD INSTRUCTIONS:
+
+  In the top level directory (the location of this README):
+	> ./configure
+	> make
+
+  "make examples" will build the example programs.
+
+  BUILD HELP:
+  Try "./configure -help"  for a list of options.
+
+  The correct Fortran90 compiler must be in your current path.
+  A frequent problem on Linux is when more than one F90 compiler
+  is in your path and configure finds one and later finds mpif90
+  for another.
+
+  Example: If configure has trouble finding the correct F90 compiler:
+    > ./configure FC=pgf90. 
+
+  You can also direct configure through environment variables:
+    > setenv FC xlf90
+    > ./configure
+
+  If the build fails, please do the following:
+    > ./configure >& config.out
+    > make >& make.out
+  and send us config.out, make.out and config.log (which is produced by the
+  configure command)
+
+  PLATFORM NOTES:
+  On a BlueGene/P, use:
+  >  ./configure FC=bgxlf90_r CC=mpixlc_r MPIFC=mpixlf90_r (can also use versions without _r)
+  At ALCF, one can just type "./configure".
+
+  On the Cray X* (e.g. jaguar) use:
+  > ./configure --host=Linux FC=ftn MPIFC=ftn 
+
+######################################################################
+  INSTALLATION INSTRUCTIONS:
+
+  "make install" will copy the .mod files to the /usr/include directory
+  and the *lib.a files to /usr/lib.   To override these choices, use
+  "-prefix" when running configure:
+       > ./configure --prefix=/home/$USER
+  With the above option, "make install" will place .mod's in /home/$USER/include 
+  and *lib.a's in /home/$USER/lib
+
+######################################################################
+  BUILDING AND RUNNING THE EXAMPLES
+
+  The programs in MCT/examples/simple require no input.
+
+  The programs in MCT/examples/climate_concur1 and MCT/examples/climate_sequen1
+  require some input data in a directory called MCT/data.  The dataset is available with MCT
+   or separately from the website.
+
+  To build them, type "make examples" in the top level directory or
+  cd to examples and type "make".
+
+######################################################################
+
+  Both MCT and MPEU source code are self-documenting.  All modules 
+  and routines contain prologues that can be extracted and processed 
+  into LaTeX source code by the public-domain tool ProTeX.  ProTeX is
+  available by anonymous ftp from:
+
+     Software:
+      ftp://dao.gsfc.nasa.gov/pub/papers/sawyer/protex1.4.tar.Z 
+     Documentation:
+      ftp://dao.gsfc.nasa.gov/pub/office_notes/on9711r0.ps.Z 
+
+  You can build the documentation with protex and latex by following
+  the directions in the doc directory.
+
+######################################################################
+
+  REVISION HISTORY:
+
+  18 Oct, 2000 -- Initial prototype
+  09 Feb, 2001 -- working MxN transfer
+  27 Apr, 2001 -- Sparse Matrix Multiply
+  13 Jun, 2001 -- General Grid
+  23 Aug, 2001 -- Linux PGF90 port
+  14 Dec, 2001 -- PCM support
+  29 Mar, 2002 -- Rearranger
+  14 Nov, 2002 -- version 1.0.0 -- first public release
+  11 Feb, 2003 -- version 1.0.4
+  12 Mar, 2003 -- version 1.0.5
+  02 Apr, 2003 -- version 1.0.7
+  03 Jul, 2003 -- version 1.0.9
+  26 Aug, 2003 -- version 1.0.12
+  12 Sep, 2003 -- version 1.0.14
+  21 Jan, 2004 -- version 1.4.0
+  05 Feb, 2004 -- version 1.6.0
+  23 Apr, 2004 -- version 2.0.0
+  18 May, 2004 -- version 2.0.1
+  11 Jul, 2004 -- version 2.0.2
+  19 Oct, 2004 -- version 2.0.3 (not released)
+  21 Jan, 2005 -- version 2.1.0
+  01 Dec, 2005 -- version 2.2.0
+  22 Apr, 2006 -- version 2.2.1 (not released)
+  08 Sep, 2006 -- version 2.2.2
+  16 Oct, 2006 -- version 2.2.3
+  10 Jan, 2007 -- version 2.3.0
+  17 Aug, 2007 -- version 2.4.0
+  21 Nov, 2007 -- version 2.4.1
+  20 Dec, 2007 -- version 2.4.2 (not released)
+  21 Jan, 2008 -- version 2.4.3 (not released)
+  28 Jan, 2008 -- version 2.5.0
+  20 May, 2008 -- version 2.5.1
+  05 Mar, 2009 -- version 2.6.0
+  05 Jan, 2010 -- version 2.7.0 (released only in CCSM4)
+  28 Feb, 2010 -- version 2.7.1 (released only in CESM1)
+  30 Nov, 2010 -- version 2.7.2 (released only in CESM1.0.3)
+  25 Jan, 2011 -- version 2.7.3 (not released)
+  07 Mar, 2012 -- version 2.7.4 (not released)
+  30 Apr, 2012 -- version 2.8.0 
+
+
+Tag MCT_2_8_0
+README,v 1.49 2012-04-27 21:52:58 jacob Exp
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/aclocal.m4
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/aclocal.m4	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/aclocal.m4	(revision 4775)
@@ -0,0 +1,16 @@
+# generated automatically by aclocal 1.10 -*- Autoconf -*-
+
+# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+# 2005, 2006  Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+m4_include([m4/acx_mpi.m4])
+m4_include([m4/ax_fc_version.m4])
+m4_include([m4/fortran.m4])
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/config.h.in
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/config.h.in	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/config.h.in	(revision 4775)
@@ -0,0 +1,81 @@
+/* config.h.in.  Generated from configure.ac by autoheader.  */
+
+/* Define if building universal (internal helper macro) */
+#undef AC_APPLE_UNIVERSAL_BUILD
+
+/* Define to dummy `main' function (if any) required to link to the Fortran
+   libraries. */
+#undef FC_DUMMY_MAIN
+
+/* Define if F77 and FC dummy `main' functions are identical. */
+#undef FC_DUMMY_MAIN_EQ_F77
+
+/* Define to a macro mangling the given C identifier (in lower and upper
+   case), which must not contain underscores, for linking with Fortran. */
+#undef FC_FUNC
+
+/* As FC_FUNC, but for C identifiers containing underscores. */
+#undef FC_FUNC_
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define if you have the MPI library. */
+#undef HAVE_MPI
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
+
+/* Define to the home page for this package. */
+#undef PACKAGE_URL
+
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
+   significant byte first (like Motorola and SPARC, unlike Intel). */
+#if defined AC_APPLE_UNIVERSAL_BUILD
+# if defined __BIG_ENDIAN__
+#  define WORDS_BIGENDIAN 1
+# endif
+#else
+# ifndef WORDS_BIGENDIAN
+#  undef WORDS_BIGENDIAN
+# endif
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure	(revision 4775)
@@ -0,0 +1,6463 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.65 for MCT 2.8.
+#
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
+# Inc.
+#
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+if test "x$CONFIG_SHELL" = x; then
+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '\${1+\"\$@\"}'='\"\$@\"'
+  setopt NO_GLOB_SUBST
+else
+  case \`(set -o) 2>/dev/null\` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+"
+  as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+  exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1"
+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+  if (eval "$as_required") 2>/dev/null; then :
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  as_found=:
+  case $as_dir in #(
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     # Try only shells that exist, to save several forks.
+	     as_shell=$as_dir/$as_base
+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  CONFIG_SHELL=$as_shell as_have_required=yes
+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+  break 2
+fi
+fi
+	   done;;
+       esac
+  as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+  CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+      if test "x$CONFIG_SHELL" != x; then :
+  # We cannot yet assume a decent shell, so we have to provide a
+	# neutralization value for shells without unset; and this also
+	# works around shells that cannot unset nonexistent variables.
+	BASH_ENV=/dev/null
+	ENV=/dev/null
+	(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+	export CONFIG_SHELL
+	exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
+fi
+
+    if test x$as_have_required = xno; then :
+  $as_echo "$0: This script requires a shell more modern than all"
+  $as_echo "$0: the shells that I found on your system."
+  if test x${ZSH_VERSION+set} = xset ; then
+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
+  else
+    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
+  fi
+  exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$?; test $as_status -eq 0 && as_status=1
+  if test "$3"; then
+    as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+  fi
+  $as_echo "$as_me: error: $1" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+
+  as_lineno_1=$LINENO as_lineno_1a=$LINENO
+  as_lineno_2=$LINENO as_lineno_2a=$LINENO
+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -p'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -p'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -p'
+  fi
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+	test -d "$1/.";
+      else
+	case $1 in #(
+	-*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+
+# Identity of this package.
+PACKAGE_NAME='MCT'
+PACKAGE_TARNAME='mct'
+PACKAGE_VERSION='2.8'
+PACKAGE_STRING='MCT 2.8'
+PACKAGE_BUGREPORT=''
+PACKAGE_URL=''
+
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+CPPDEFS
+CRULE
+FCLIBS
+FC_DEFINE
+FCFLAGS_F
+MPISERPATH
+MPIFC
+FCFLAGS_F90
+ac_ct_FC
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CC
+PYTHONOPTS
+PYTHON
+FORT_SIZE
+COMPILER_ROOT
+BABELROOT
+AR
+INCLUDEPATH
+INCLUDEFLAG
+ENDIAN
+BIT64
+REAL8
+OPT
+DEBUG
+CFLAGS
+PROGFCFLAGS
+FCFLAGS
+FC
+FPPFLAGS
+FPP
+MPIHEADER
+MPILIBS
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
+ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+enable_mpiserial
+enable_debugging
+enable_selectedrealkind
+enable_sequence
+enable_babel
+'
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+MPILIBS
+MPIHEADER
+FPP
+FPPFLAGS
+FC
+FCFLAGS
+PROGFCFLAGS
+CFLAGS
+DEBUG
+OPT
+REAL8
+BIT64
+ENDIAN
+INCLUDEFLAG
+INCLUDEPATH
+AR
+BABELROOT
+COMPILER_ROOT
+FORT_SIZE
+CC
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP
+MPIFC'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=*)	ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *)	ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid feature name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"enable_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval enable_$ac_useropt=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+      as_fn_error "invalid package name: $ac_useropt"
+    ac_useropt_orig=$ac_useropt
+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+    case $ac_user_opts in
+      *"
+"with_$ac_useropt"
+"*) ;;
+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+	 ac_unrecognized_sep=', ';;
+    esac
+    eval with_$ac_useropt=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) as_fn_error "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information."
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    case $ac_envvar in #(
+      '' | [0-9]* | *[!_$as_cr_alnum]* )
+      as_fn_error "invalid variable name: \`$ac_envvar'" ;;
+    esac
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  as_fn_error "missing argument to $ac_option"
+fi
+
+if test -n "$ac_unrecognized_opts"; then
+  case $enable_option_checking in
+    no) ;;
+    fatal) as_fn_error "unrecognized options: $ac_unrecognized_opts" ;;
+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
+  esac
+fi
+
+# Check all directory arguments for consistency.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  # Remove trailing slashes.
+  case $ac_val in
+    */ )
+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+      eval $ac_var=\$ac_val;;
+  esac
+  # Be sure to have absolute directory names.
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  as_fn_error "expected an absolute directory name for --$ac_var: $ac_val"
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+    $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+    If a cross compiler is detected then cross compile mode will be used." >&2
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  as_fn_error "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  as_fn_error "pwd does not report name of working directory"
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_myself" : 'X\(//\)[^/]' \| \
+	 X"$as_myself" : 'X\(//\)$' \| \
+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  as_fn_error "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error "$ac_msg"
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+  # Omit some internal or obsolete options to make the list less imposing.
+  # This message is too long to be a string in the A/UX 3.1 sh.
+  cat <<_ACEOF
+\`configure' configures MCT 2.8 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+                          [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+                          [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR            user executables [EPREFIX/bin]
+  --sbindir=DIR           system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR        program executables [EPREFIX/libexec]
+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --libdir=DIR            object code libraries [EPREFIX/lib]
+  --includedir=DIR        C header files [PREFIX/include]
+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR           info documentation [DATAROOTDIR/info]
+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR            man documentation [DATAROOTDIR/man]
+  --docdir=DIR            documentation root [DATAROOTDIR/doc/mct]
+  --htmldir=DIR           html documentation [DOCDIR]
+  --dvidir=DIR            dvi documentation [DOCDIR]
+  --pdfdir=DIR            pdf documentation [DOCDIR]
+  --psdir=DIR             ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of MCT 2.8:";;
+   esac
+  cat <<\_ACEOF
+
+Optional Features:
+  --disable-option-checking  ignore unrecognized --enable/--with options
+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
+  --enable-mpiserial      Use the included MPI replacement library for single
+                          processor
+  --enable-debugging      Use the debugging flag and disable the optimization
+                          flag
+  --enable-selectedrealkind
+                          define single precision and double precision numbers
+                          using the selected_real_kind function. Default uses
+                          the kind inquiry function.
+  --enable-sequence       Modify MCT types to make them contiguous in memory.
+  --enable-babel          Supply this option if you plan on building the Babel
+                          bindings to MCT
+
+Some influential environment variables:
+  MPILIBS     MPI library command line invocation
+  MPIHEADER   MPI header include path with INCLUDEFLAG
+  FPP         C-preprocessor for Fortran source code
+  FPPFLAGS    C-preprocessing flags for Fortran source code
+  FC          The Fortran compiler
+  FCFLAGS     User-defined Fortran compiler flags
+  PROGFCFLAGS User-defined Fortran compiler flags for example programs
+  CFLAGS      Customized C source compilation flags
+  DEBUG       Fortran compiler flag for generating symbolic debugging
+              information
+  OPT         Fortran compiler flag for optimization level
+  REAL8       Fortran compiler flag for setting the default REAL size to
+              REAL(KIND=8)
+  BIT64       Fortran compiler flag for generating 64-bit objects
+  ENDIAN      Fortran compiler flag for converting big-endian to little-endian
+  INCLUDEFLAG Fortran compiler flag for specifying module search path
+  INCLUDEPATH Additional library and module paths with INCLUDEFLAG
+  AR          Archive command
+  BABELROOT   Root directory of your Babel installation. i.e.:
+              $BABELROOT/bin/babel $BABELROOT/lib/libsidl.so
+  COMPILER_ROOT
+              Root directory of your FORTRAN compiler
+  FORT_SIZE   Number of bits in Fortran real and double kind
+  CC          C compiler command
+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+              nonstandard directory <lib dir>
+  LIBS        libraries to pass to the linker, e.g. -l<library>
+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
+              you have headers in a nonstandard directory <include dir>
+  CPP         C preprocessor
+  MPIFC       MPI Fortran compiler command
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to the package provider.
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" ||
+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+      continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+MCT configure 2.8
+generated by GNU Autoconf 2.65
+
+Copyright (C) 2009 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: program exited with status $ac_status" >&5
+       $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+       ac_retval=$ac_status
+fi
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+    ac_retval=1
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if { as_var=$3; eval "test \"\${$as_var+set}\" = set"; }; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  eval "$3=yes"
+else
+  eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_fc_try_compile LINENO
+# ---------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_fc_try_compile ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext
+  if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_fc_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_fc_try_compile
+
+# ac_fn_fc_try_link LINENO
+# ------------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_fc_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_fc_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 $as_test_x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_fc_try_link
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+  rm -f conftest.$ac_objext conftest$ac_exeext
+  if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    grep -v '^ *+' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+    mv -f conftest.er1 conftest.err
+  fi
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext && {
+	 test "$cross_compiling" = yes ||
+	 $as_test_x conftest$ac_exeext
+       }; then :
+  ac_retval=0
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_retval=1
+fi
+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+  # interfere with the next link command; also delete a directory that is
+  # left behind by Apple's compiler.  We do this before executing the actions.
+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+  eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;}
+  as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+cat >config.log <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by MCT $as_me 2.8, which was
+generated by GNU Autoconf 2.65.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    $as_echo "PATH: $as_dir"
+  done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
+    2)
+      as_fn_append ac_configure_args1 " '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      as_fn_append ac_configure_args " '$ac_arg'"
+      ;;
+    esac
+  done
+done
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      $as_echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      cat <<\_ASBOX
+## ------------------- ##
+## File substitutions. ##
+## ------------------- ##
+_ASBOX
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	$as_echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      $as_echo "$as_me: caught signal $ac_signal"
+    $as_echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+  ac_site_file1=$CONFIG_SITE
+elif test "x$prefix" != xNONE; then
+  ac_site_file1=$prefix/share/config.site
+  ac_site_file2=$prefix/etc/config.site
+else
+  ac_site_file1=$ac_default_prefix/share/config.site
+  ac_site_file2=$ac_default_prefix/etc/config.site
+fi
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+  test "x$ac_site_file" = xNONE && continue
+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special files
+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	# differences in whitespace do not lead to failure.
+	ac_old_val_w=`echo x $ac_old_val`
+	ac_new_val_w=`echo x $ac_new_val`
+	if test "$ac_old_val_w" != "$ac_new_val_w"; then
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	  ac_cache_corrupted=:
+	else
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+	  eval $ac_var=\$ac_old_val
+	fi
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  as_fn_error "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
+fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+# PROCESS THE FOLLOWING MAKEFILES
+
+ac_config_files="$ac_config_files Makefile.conf"
+
+ac_config_headers="$ac_config_headers config.h"
+
+
+# DECLARE PACKAGE OPTIONS
+
+# Check whether --enable-mpiserial was given.
+if test "${enable_mpiserial+set}" = set; then :
+  enableval=$enable_mpiserial; DONOTCHECKMPI="DONOTCHECKMPI"
+
+fi
+
+
+# Check whether --enable-debugging was given.
+if test "${enable_debugging+set}" = set; then :
+  enableval=$enable_debugging; DEBUGGING="ENABLED"
+
+fi
+
+
+# Check whether --enable-selectedrealkind was given.
+if test "${enable_selectedrealkind+set}" = set; then :
+  enableval=$enable_selectedrealkind; SRKDEF="SELECTEDREALKIND"
+
+fi
+
+
+# Check whether --enable-sequence was given.
+if test "${enable_sequence+set}" = set; then :
+  enableval=$enable_sequence; SRKDEF="SEQUENCE"
+fi
+
+
+# Check whether --enable-babel was given.
+if test "${enable_babel+set}" = set; then :
+  enableval=$enable_babel; SRKDEF="SEQUENCE"
+fi
+
+
+
+
+# DECLARE THE FOLLOWING PRECIOUS VARIABLES
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# INCLUDE BABELROOT and COMPILER_ROOT in Makefile.conf(autoconf output)
+
+
+
+
+
+# SET TEMPORARY VARIABLES
+
+# OS AND PLATFORM NAME
+test "$osname"=NONE && osname=`uname -s`
+test "$machinename"=NONE && machinename=`uname -m`
+fullhostname=`hostname -f`
+
+
+# HARDCODE SPECIFIC MACHINES FOR EXTRAORDINARY CIRCUMSTANCES
+
+# CHECK IF WE ARE ON THE EARTH SIMULATOR
+ES="NO"
+if echo $osname | grep -i esos >/dev/null 2>&1; then
+   ES="YES"
+fi
+if echo $osname | grep -i hp-ux >/dev/null 2>&1; then
+   if test "$ac_hostname" = "moon"; then
+      ES="YES"
+      # TELLS CONFIGURE NOT TO RUN ANY TESTS THAT REQUIRE EXECUTION
+      cross_compiling="yes"
+   fi
+fi
+if test "$ES" = "YES"; then
+   echo "Using preset configuration values for the Earth Simulator"
+   if test -z "$CC"; then
+      CC="escc"
+   fi
+   if test -z "$FC"; then
+      FC="esf90"
+   fi
+   if test -z "$MPIFC"; then
+      MPIFC="esmpif90"
+   fi
+   if test -z "$AR"; then
+      AR="esar cqs"
+   fi
+   if test -z "FPP"; then
+      FPPFLAGS=" "
+   fi
+   if test -z "$FCFLAGS"; then
+      FCFLAGS="-EP -Wf'-pvctl fullmsg -L fmtlist transform map'"
+   fi
+   if test -z "$OPT"; then
+      OPT="-C vopt"
+   fi
+   if test -z "$CPPDEFS"; then
+      CPPDEFS="-DESVEC"
+   fi
+fi
+
+# Check if we are on the ANL BG/P
+
+if echo $fullhostname | egrep -q '.\.(challenger|intrepid)\.alcf\.anl\.gov'
+  then if test -z "$FC"; then
+         FC=bgxlf90_r
+       fi
+       if test -z "$MPIFC"; then
+         MPIFC=mpixlf90_r
+       fi
+       if test -z "$CC"; then
+         CC=mpixlc_r
+       fi
+fi
+
+
+
+# START TESTS
+
+# CHECK FOR THE C COMPILER
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  for ac_prog in cc
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cc
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "no acceptable C compiler found in \$PATH
+See \`config.log' for more details." "$LINENO" 5; }
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+if test -z "$ac_file"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+{ as_fn_set_status 77
+as_fn_error "C compiler cannot create executables
+See \`config.log' for more details." "$LINENO" 5; }; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
+ac_exeext=$ac_cv_exeext
+
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+  { { ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+  if { ac_try='./conftest$ac_cv_exeext'
+  { { case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." "$LINENO" 5; }
+    fi
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if test "${ac_cv_objext+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }; then :
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if test "${ac_cv_c_compiler_gnu+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+  GCC=yes
+else
+  GCC=
+fi
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if test "${ac_cv_prog_cc_g+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+else
+  CFLAGS=""
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+  ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_prog_cc_c89=$ac_arg
+fi
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+  xno)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
+
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+# CHECK FOR BYTE ORDERING
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if test "${ac_cv_prog_CPP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+
+else
+  # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+  # Broken: success on invalid input.
+continue
+else
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if test "${ac_cv_path_GREP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -z "$GREP"; then
+  ac_path_GREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in grep ggrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_GREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_GREP"; then
+    as_fn_error "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if test "${ac_cv_path_EGREP+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     if test -z "$EGREP"; then
+  ac_path_EGREP_found=false
+  # Loop through the user's path and test for each of PROGNAME-LIST
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_prog in egrep; do
+    for ac_exec_ext in '' $ac_executable_extensions; do
+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  $as_echo_n 0123456789 >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    $as_echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    as_fn_arith $ac_count + 1 && ac_count=$as_val
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+      $ac_path_EGREP_found && break 3
+    done
+  done
+  done
+IFS=$as_save_IFS
+  if test -z "$ac_cv_path_EGREP"; then
+    as_fn_error "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+  fi
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+   fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if test "${ac_cv_header_stdc+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_header_stdc=yes
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then :
+  :
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+
+else
+  ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do :
+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+eval as_val=\$$as_ac_Header
+   if test "x$as_val" = x""yes; then :
+  cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
+$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
+if test "${ac_cv_c_bigendian+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_cv_c_bigendian=unknown
+    # See if we're dealing with a universal compiler.
+    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#ifndef __APPLE_CC__
+	       not a universal capable compiler
+	     #endif
+	     typedef int dummy;
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+	# Check for potential -arch flags.  It is not universal unless
+	# there are at least two -arch flags with different values.
+	ac_arch=
+	ac_prev=
+	for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
+	 if test -n "$ac_prev"; then
+	   case $ac_word in
+	     i?86 | x86_64 | ppc | ppc64)
+	       if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
+		 ac_arch=$ac_word
+	       else
+		 ac_cv_c_bigendian=universal
+		 break
+	       fi
+	       ;;
+	   esac
+	   ac_prev=
+	 elif test "x$ac_word" = "x-arch"; then
+	   ac_prev=arch
+	 fi
+       done
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    if test $ac_cv_c_bigendian = unknown; then
+      # See if sys/param.h defines the BYTE_ORDER macro.
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+	     #include <sys/param.h>
+
+int
+main ()
+{
+#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
+		     && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
+		     && LITTLE_ENDIAN)
+	      bogus endian macros
+	     #endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  # It does; now see whether it defined to BIG_ENDIAN or not.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <sys/types.h>
+		#include <sys/param.h>
+
+int
+main ()
+{
+#if BYTE_ORDER != BIG_ENDIAN
+		 not big endian
+		#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_c_bigendian=yes
+else
+  ac_cv_c_bigendian=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    fi
+    if test $ac_cv_c_bigendian = unknown; then
+      # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <limits.h>
+
+int
+main ()
+{
+#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
+	      bogus endian macros
+	     #endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  # It does; now see whether it defined to _BIG_ENDIAN or not.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#include <limits.h>
+
+int
+main ()
+{
+#ifndef _BIG_ENDIAN
+		 not big endian
+		#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  ac_cv_c_bigendian=yes
+else
+  ac_cv_c_bigendian=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+    fi
+    if test $ac_cv_c_bigendian = unknown; then
+      # Compile a test program.
+      if test "$cross_compiling" = yes; then :
+  # Try to guess by grepping values from an object file.
+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+short int ascii_mm[] =
+		  { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+		short int ascii_ii[] =
+		  { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+		int use_ascii (int i) {
+		  return ascii_mm[i] + ascii_ii[i];
+		}
+		short int ebcdic_ii[] =
+		  { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+		short int ebcdic_mm[] =
+		  { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+		int use_ebcdic (int i) {
+		  return ebcdic_mm[i] + ebcdic_ii[i];
+		}
+		extern int foo;
+
+int
+main ()
+{
+return use_ascii (foo) == use_ebcdic (foo);
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+  if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
+	      ac_cv_c_bigendian=yes
+	    fi
+	    if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+	      if test "$ac_cv_c_bigendian" = unknown; then
+		ac_cv_c_bigendian=no
+	      else
+		# finding both strings is unlikely to happen, but who knows?
+		ac_cv_c_bigendian=unknown
+	      fi
+	    fi
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+$ac_includes_default
+int
+main ()
+{
+
+	     /* Are we little or big endian?  From Harbison&Steele.  */
+	     union
+	     {
+	       long int l;
+	       char c[sizeof (long int)];
+	     } u;
+	     u.l = 1;
+	     return u.c[sizeof (long int) - 1] == 1;
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  ac_cv_c_bigendian=no
+else
+  ac_cv_c_bigendian=yes
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+    fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
+$as_echo "$ac_cv_c_bigendian" >&6; }
+ case $ac_cv_c_bigendian in #(
+   yes)
+     $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
+;; #(
+   no)
+      ;; #(
+   universal)
+
+$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
+
+     ;; #(
+   *)
+     as_fn_error "unknown endianness
+ presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
+ esac
+
+
+# CHECK FOR THE FORTRAN COMPILER
+# RLJ- specify the order, include PathScale and do not search for F77
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  for ac_prog in xlf95 pgf95 ifort gfortran pathf95 ftn lf95 f95 fort ifc efc g95 xlf90 pgf90 pathf90 epcf90 pghpf
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_FC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$FC"; then
+  ac_cv_prog_FC="$FC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_FC="$ac_tool_prefix$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+FC=$ac_cv_prog_FC
+if test -n "$FC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FC" >&5
+$as_echo "$FC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+    test -n "$FC" && break
+  done
+fi
+if test -z "$FC"; then
+  ac_ct_FC=$FC
+  for ac_prog in xlf95 pgf95 ifort gfortran pathf95 ftn lf95 f95 fort ifc efc g95 xlf90 pgf90 pathf90 epcf90 pghpf
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_ac_ct_FC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_FC"; then
+  ac_cv_prog_ac_ct_FC="$ac_ct_FC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_FC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_FC=$ac_cv_prog_ac_ct_FC
+if test -n "$ac_ct_FC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_FC" >&5
+$as_echo "$ac_ct_FC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$ac_ct_FC" && break
+done
+
+  if test "x$ac_ct_FC" = x; then
+    FC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+    FC=$ac_ct_FC
+  fi
+fi
+
+
+# Provide some information about the compiler.
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+  { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
+  ac_status=$?
+  if test -s conftest.err; then
+    sed '10a\
+... rest of stderr output deleted ...
+         10q' conftest.err >conftest.er1
+    cat conftest.er1 >&5
+  fi
+  rm -f conftest.er1 conftest.err
+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+  test $ac_status = 0; }
+done
+rm -f a.out
+
+# If we don't use `.F' as extension, the preprocessor is not run on the
+# input file.  (Note that this only needs to work for GNU compilers.)
+ac_save_ext=$ac_ext
+ac_ext=F
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran compiler" >&5
+$as_echo_n "checking whether we are using the GNU Fortran compiler... " >&6; }
+if test "${ac_cv_fc_compiler_gnu+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+#ifndef __GNUC__
+       choke me
+#endif
+
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_compiler_gnu=yes
+else
+  ac_compiler_gnu=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_fc_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_compiler_gnu" >&5
+$as_echo "$ac_cv_fc_compiler_gnu" >&6; }
+ac_ext=$ac_save_ext
+ac_test_FCFLAGS=${FCFLAGS+set}
+ac_save_FCFLAGS=$FCFLAGS
+FCFLAGS=
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $FC accepts -g" >&5
+$as_echo_n "checking whether $FC accepts -g... " >&6; }
+if test "${ac_cv_prog_fc_g+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  FCFLAGS=-g
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_cv_prog_fc_g=yes
+else
+  ac_cv_prog_fc_g=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_g" >&5
+$as_echo "$ac_cv_prog_fc_g" >&6; }
+if test "$ac_test_FCFLAGS" = set; then
+  FCFLAGS=$ac_save_FCFLAGS
+elif test $ac_cv_prog_fc_g = yes; then
+  if test "x$ac_cv_fc_compiler_gnu" = xyes; then
+    FCFLAGS="-g -O2"
+  else
+    FCFLAGS="-g"
+  fi
+else
+  if test "x$ac_cv_fc_compiler_gnu" = xyes; then
+    FCFLAGS="-O2"
+  else
+    FCFLAGS=
+  fi
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+# CHECK FOR MPI LIBRARIES
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag to compile .F90 files" >&5
+$as_echo_n "checking for Fortran flag to compile .F90 files... " >&6; }
+if test "${ac_cv_fc_srcext_F90+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_ext=F90
+ac_fcflags_srcext_save=$ac_fcflags_srcext
+ac_fcflags_srcext=
+ac_cv_fc_srcext_F90=unknown
+for ac_flag in none -qsuffix=f=F90 -Tf; do
+  test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag"
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_cv_fc_srcext_F90=$ac_flag; break
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest.$ac_objext conftest.F90
+ac_fcflags_srcext=$ac_fcflags_srcext_save
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_srcext_F90" >&5
+$as_echo "$ac_cv_fc_srcext_F90" >&6; }
+if test "x$ac_cv_fc_srcext_F90" = xunknown; then
+  as_fn_error "Fortran could not compile .F90 files" "$LINENO" 5
+else
+  ac_fc_srcext=F90
+  if test "x$ac_cv_fc_srcext_F90" = xnone; then
+    ac_fcflags_srcext=""
+    FCFLAGS_F90=""
+  else
+    ac_fcflags_srcext=$ac_cv_fc_srcext_F90
+    FCFLAGS_F90=$ac_cv_fc_srcext_F90
+  fi
+
+
+fi
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+
+OLDFCFLAGS="$FCFLAGS"
+
+if test -n "$MPIHEADER"; then
+   FCFLAGS="$FCFLAGS $MPIHEADER"
+fi
+
+# CHECK MPI BY DEFAULT
+if test -z "$DONOTCHECKMPI"; then
+
+
+
+
+
+	for ac_prog in mpif90 hf90 mpxlf90 mpxlf95 mpf90 cmpifc cmpif90c
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_prog_MPIFC+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$MPIFC"; then
+  ac_cv_prog_MPIFC="$MPIFC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_MPIFC="$ac_prog"
+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+  done
+IFS=$as_save_IFS
+
+fi
+fi
+MPIFC=$ac_cv_prog_MPIFC
+if test -n "$MPIFC"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIFC" >&5
+$as_echo "$MPIFC" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+  test -n "$MPIFC" && break
+done
+test -n "$MPIFC" || MPIFC="$FC"
+
+	acx_mpi_save_FC="$FC"
+	FC="$MPIFC"
+
+
+
+if test x = x"$MPILIBS"; then
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init" >&5
+$as_echo_n "checking for MPI_Init... " >&6; }
+			cat > conftest.$ac_ext <<_ACEOF
+      program main
+      call MPI_Init
+      end
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+  MPILIBS=" "
+				{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+fi
+
+	if test x = x"$MPILIBS"; then
+		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lfmpi" >&5
+$as_echo_n "checking for MPI_Init in -lfmpi... " >&6; }
+if test "${ac_cv_lib_fmpi_MPI_Init+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lfmpi  $LIBS"
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+      call MPI_Init
+      end
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+  ac_cv_lib_fmpi_MPI_Init=yes
+else
+  ac_cv_lib_fmpi_MPI_Init=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fmpi_MPI_Init" >&5
+$as_echo "$ac_cv_lib_fmpi_MPI_Init" >&6; }
+if test "x$ac_cv_lib_fmpi_MPI_Init" = x""yes; then :
+  MPILIBS="-lfmpi"
+fi
+
+	fi
+	if test x = x"$MPILIBS"; then
+		{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpichf90" >&5
+$as_echo_n "checking for MPI_Init in -lmpichf90... " >&6; }
+if test "${ac_cv_lib_mpichf90_MPI_Init+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lmpichf90  $LIBS"
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+      call MPI_Init
+      end
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+  ac_cv_lib_mpichf90_MPI_Init=yes
+else
+  ac_cv_lib_mpichf90_MPI_Init=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpichf90_MPI_Init" >&5
+$as_echo "$ac_cv_lib_mpichf90_MPI_Init" >&6; }
+if test "x$ac_cv_lib_mpichf90_MPI_Init" = x""yes; then :
+  MPILIBS="-lmpichf90"
+fi
+
+	fi
+
+if test x = x"$MPILIBS"; then
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpi" >&5
+$as_echo_n "checking for MPI_Init in -lmpi... " >&6; }
+if test "${ac_cv_lib_mpi_MPI_Init+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lmpi  $LIBS"
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+      call MPI_Init
+      end
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+  ac_cv_lib_mpi_MPI_Init=yes
+else
+  ac_cv_lib_mpi_MPI_Init=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpi_MPI_Init" >&5
+$as_echo "$ac_cv_lib_mpi_MPI_Init" >&6; }
+if test "x$ac_cv_lib_mpi_MPI_Init" = x""yes; then :
+  MPILIBS="-lmpi"
+fi
+
+fi
+if test x = x"$MPILIBS"; then
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpich" >&5
+$as_echo_n "checking for MPI_Init in -lmpich... " >&6; }
+if test "${ac_cv_lib_mpich_MPI_Init+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lmpich  $LIBS"
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+      call MPI_Init
+      end
+_ACEOF
+if ac_fn_fc_try_link "$LINENO"; then :
+  ac_cv_lib_mpich_MPI_Init=yes
+else
+  ac_cv_lib_mpich_MPI_Init=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpich_MPI_Init" >&5
+$as_echo "$ac_cv_lib_mpich_MPI_Init" >&6; }
+if test "x$ac_cv_lib_mpich_MPI_Init" = x""yes; then :
+  MPILIBS="-lmpich"
+fi
+
+fi
+
+if test x != x"$MPILIBS"; then
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpif.h" >&5
+$as_echo_n "checking for mpif.h... " >&6; }
+	cat > conftest.$ac_ext <<_ACEOF
+      program main
+      include 'mpif.h'
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+  MPILIBS=""
+		{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+FC="$acx_mpi_save_FC"
+
+
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x = x"$MPILIBS"; then
+
+        :
+else
+
+$as_echo "#define HAVE_MPI 1" >>confdefs.h
+
+        :
+fi
+
+fi
+
+# DONT CHECK MPI IF SERIALMPI OPTION IS ENABLED
+if test -n "$DONOTCHECKMPI"; then
+   echo "MPISERIAL ENABLED: BYPASSING MPI CHECK"
+   if test -z "$MPIFC"; then
+      MPIFC=$FC
+   fi
+   if test -z "$FORT_SIZE"; then
+      FORT_SIZE="real4double8"
+      echo "FORT_SIZE IS PRESET TO $FORT_SIZE"
+   fi
+   abs_top_builddir=`pwd`
+   MPISERPATH=$abs_top_builddir/mpi-serial
+
+   MPIHEADER=-I$MPISERPATH
+   MPILIBS="-L$MPISERPATH -lmpi-serial"
+fi
+
+FCFLAGS="$OLDFCFLAGS"
+
+# A HACK TO FIX ACX_MPI TO GET MPILIBS TO BE AN EMPTY STRING
+if test "$MPILIBS" = " "; then
+   MPILIBS=""
+fi
+
+# SET FC TO MPIFC. IF MPILIBS IS PRESENT, SET FC TO FC.
+if test -z "$FC"; then
+   FC=$MPIFC
+   if test "$FC" != "$MPIFC";  then
+      if test -n "$MPILIBS"; then
+	 FC=$FC
+      fi
+   fi
+fi
+
+# FOR SANITY, CHECK THAT FILENAME EXTENSION FOR FC IS CONSISTENT WITH FC
+OLDFC="$FC"
+FC="$FC"
+
+cat > conftest.$ac_ext <<_ACEOF
+       subroutine oof()
+             return
+          end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $FC FAILED TO COMPILE FILENAME EXTENSION $ac_ext" >&5
+$as_echo "$as_me: WARNING: $FC FAILED TO COMPILE FILENAME EXTENSION $ac_ext" >&2;}
+
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+
+
+FC="$OLDFC"
+
+# CHECK HOW TO GET THE COMPILER VERSION.
+echo "Checking Compiler Version"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get the version output from $FC" >&5
+$as_echo_n "checking how to get the version output from $FC... " >&6; }
+if test "${ac_cv_prog_fc_version+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_cv_prog_fc_version=
+# Try some options frequently used verbose output
+for ac_version in -V -version --version +version -qversion; do
+  ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+
+# Compile and link our simple test program by passing a flag (argument
+# 1 to this macro) to the Fortran 90 compiler in order to get "version" output
+ac_save_FCFLAGS=$FCFLAGS
+FCFLAGS="$FCFLAGS $ac_version"
+(eval echo $as_me:4030: \"$ac_link\") >&5
+ac_fc_version_output=`eval $ac_link 5>&1 2>&1 | grep -v 'Driving:'`
+echo "$ac_fc_version_output" >&5
+FCFLAGS=$ac_save_FCFLAGS
+
+rm -f conftest.*
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+
+  # look for "copyright" constructs in the output
+  for ac_arg in $ac_fc_version_output; do
+     case $ac_arg in
+        COPYRIGHT | copyright | Copyright | '(c)' | '(C)' | Compiler | Compilers | Version | Version:)
+          ac_cv_prog_fc_version=$ac_version
+          break 2 ;;
+     esac
+  done
+done
+if test -z "$ac_cv_prog_fc_version"; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain version information from $FC" >&5
+$as_echo "$as_me: WARNING: cannot determine how to obtain version information from $FC" >&2;}
+fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5
+$as_echo "$as_me: WARNING: compilation failed" >&2;}
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_version" >&5
+$as_echo "$ac_cv_prog_fc_version" >&6; }
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+# Check how to use the cpp with fortran
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+ac_fc_pp_define_srcext_save=$ac_fc_srcext
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran flag to compile preprocessed .F files" >&5
+$as_echo_n "checking for Fortran flag to compile preprocessed .F files... " >&6; }
+if test "${ac_cv_fc_pp_srcext_F+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_ext=F
+ac_fcflags_pp_srcext_save=$ac_fcflags_srcext
+ac_fcflags_srcext=
+ac_cv_fc_pp_srcext_F=unknown
+case $ac_ext in #(
+  [fF]77) ac_try=f77-cpp-input;; #(
+  *) ac_try=f95-cpp-input;;
+esac
+for ac_flag in none -ftpp -fpp -Tf "-fpp -Tf" -xpp=fpp -Mpreprocess "-e Z" \
+               -cpp -xpp=cpp -qsuffix=cpp=F "-x $ac_try" +cpp -Cpp; do
+  test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag"
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+#if 0
+#include <ac_nonexistent.h>
+      choke me
+#endif
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+#if 1
+#include <ac_nonexistent.h>
+      choke me
+#endif
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+
+else
+  ac_cv_fc_pp_srcext_F=$ac_flag; break
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest.$ac_objext conftest.F
+ac_fcflags_srcext=$ac_fcflags_pp_srcext_save
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_pp_srcext_F" >&5
+$as_echo "$ac_cv_fc_pp_srcext_F" >&6; }
+if test "x$ac_cv_fc_pp_srcext_F" = xunknown; then
+  as_fn_error "Fortran could not compile preprocessed .F files" "$LINENO" 5
+else
+  ac_fc_srcext=F
+  if test "x$ac_cv_fc_pp_srcext_F" = xnone; then
+    ac_fcflags_srcext=""
+    FCFLAGS_F=""
+  else
+    ac_fcflags_srcext=$ac_cv_fc_pp_srcext_F
+    FCFLAGS_F=$ac_cv_fc_pp_srcext_F
+  fi
+
+
+fi
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to define symbols for preprocessed Fortran" >&5
+$as_echo_n "checking how to define symbols for preprocessed Fortran... " >&6; }
+if test "${ac_cv_fc_pp_define+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_fc_pp_define_srcext_save=$ac_fc_srcext
+ac_cv_fc_pp_define=unknown
+ac_fc_pp_define_FCFLAGS_save=$FCFLAGS
+for ac_flag in -D -WF,-D -Wp,-D -Wc,-D
+do
+  FCFLAGS="$ac_fc_pp_define_FCFLAGS_save ${ac_flag}FOOBAR ${ac_flag}ZORK=42"
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+#ifndef FOOBAR
+      choke me
+#endif
+#if ZORK != 42
+      choke me
+#endif
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_cv_fc_pp_define=$ac_flag
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+  test x"$ac_cv_fc_pp_define" != xunknown && break
+done
+FCFLAGS=$ac_fc_pp_define_FCFLAGS_save
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_pp_define" >&5
+$as_echo "$ac_cv_fc_pp_define" >&6; }
+ac_fc_srcext=$ac_fc_pp_define_srcext_save
+if test "x$ac_cv_fc_pp_define" = xunknown; then
+  FC_DEFINE=
+  { as_fn_set_status 77
+as_fn_error "Fortran does not allow to define preprocessor symbols" "$LINENO" 5; }
+else
+  FC_DEFINE=$ac_cv_fc_pp_define
+
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+# CHECK HOW TO NAME MANGLE C FUNCTIONS SO THAT IT CAN BE CALLED FROM FORTRAN
+OLDFC="$FC"
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from $FC" >&5
+$as_echo_n "checking how to get verbose linking output from $FC... " >&6; }
+if test "${ac_cv_prog_fc_v+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  ac_cv_prog_fc_v=
+# Try some options frequently used verbose output
+for ac_verb in -v -verbose --verbose -V -\#\#\#; do
+  cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+
+# Compile and link our simple test program by passing a flag (argument
+# 1 to this macro) to the Fortran compiler in order to get
+# "verbose" output that we can then parse for the Fortran linker
+# flags.
+ac_save_FCFLAGS=$FCFLAGS
+FCFLAGS="$FCFLAGS $ac_verb"
+eval "set x $ac_link"
+shift
+$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
+# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
+# LIBRARY_PATH; skip all such settings.
+ac_fc_v_output=`eval $ac_link 5>&1 2>&1 |
+  grep -v 'Driving:' | grep -v "^[_$as_cr_Letters][_$as_cr_alnum]*="`
+$as_echo "$ac_fc_v_output" >&5
+FCFLAGS=$ac_save_FCFLAGS
+
+rm -rf conftest*
+
+# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
+# /foo, /bar, and /baz are search directories for the Fortran linker.
+# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
+ac_fc_v_output="`echo $ac_fc_v_output |
+	grep 'LPATH is:' |
+	sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_fc_v_output"
+
+# FIXME: we keep getting bitten by quoted arguments; a more general fix
+#        that detects unbalanced quotes in FLIBS should be implemented
+#        and (ugh) tested at some point.
+case $ac_fc_v_output in
+  # If we are using xlf then replace all the commas with spaces.
+  *xlfentry*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/,/ /g'` ;;
+
+  # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted
+  # $LIBS confuse us, and the libraries appear later in the output anyway).
+  *mGLOB_options_string*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;;
+
+  # Portland Group compiler has singly- or doubly-quoted -cmdline argument
+  # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4.
+  # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
+  *-cmdline\ * | *-ignore\ * | *-def\ *)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed "\
+	s/-cmdline  *'[^']*'/ /g; s/-cmdline  *\"[^\"]*\"/ /g
+	s/-ignore  *'[^']*'/ /g; s/-ignore  *\"[^\"]*\"/ /g
+	s/-def  *'[^']*'/ /g; s/-def  *\"[^\"]*\"/ /g"` ;;
+
+  # If we are using Cray Fortran then delete quotes.
+  *cft90*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/"//g'` ;;
+esac
+
+
+  # look for -l* and *.a constructs in the output
+  for ac_arg in $ac_fc_v_output; do
+     case $ac_arg in
+	[\\/]*.a | ?:[\\/]*.a | -[lLRu]*)
+	  ac_cv_prog_fc_v=$ac_verb
+	  break 2 ;;
+     esac
+  done
+done
+if test -z "$ac_cv_prog_fc_v"; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from $FC" >&5
+$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from $FC" >&2;}
+fi
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5
+$as_echo "$as_me: WARNING: compilation failed" >&2;}
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_fc_v" >&5
+$as_echo "$ac_cv_prog_fc_v" >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran libraries of $FC" >&5
+$as_echo_n "checking for Fortran libraries of $FC... " >&6; }
+if test "${ac_cv_fc_libs+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test "x$FCLIBS" != "x"; then
+  ac_cv_fc_libs="$FCLIBS" # Let the user override the test.
+else
+
+cat > conftest.$ac_ext <<_ACEOF
+      program main
+
+      end
+_ACEOF
+
+# Compile and link our simple test program by passing a flag (argument
+# 1 to this macro) to the Fortran compiler in order to get
+# "verbose" output that we can then parse for the Fortran linker
+# flags.
+ac_save_FCFLAGS=$FCFLAGS
+FCFLAGS="$FCFLAGS $ac_cv_prog_fc_v"
+eval "set x $ac_link"
+shift
+$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
+# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
+# LIBRARY_PATH; skip all such settings.
+ac_fc_v_output=`eval $ac_link 5>&1 2>&1 |
+  grep -v 'Driving:' | grep -v "^[_$as_cr_Letters][_$as_cr_alnum]*="`
+$as_echo "$ac_fc_v_output" >&5
+FCFLAGS=$ac_save_FCFLAGS
+
+rm -rf conftest*
+
+# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
+# /foo, /bar, and /baz are search directories for the Fortran linker.
+# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
+ac_fc_v_output="`echo $ac_fc_v_output |
+	grep 'LPATH is:' |
+	sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_fc_v_output"
+
+# FIXME: we keep getting bitten by quoted arguments; a more general fix
+#        that detects unbalanced quotes in FLIBS should be implemented
+#        and (ugh) tested at some point.
+case $ac_fc_v_output in
+  # If we are using xlf then replace all the commas with spaces.
+  *xlfentry*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/,/ /g'` ;;
+
+  # With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted
+  # $LIBS confuse us, and the libraries appear later in the output anyway).
+  *mGLOB_options_string*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;;
+
+  # Portland Group compiler has singly- or doubly-quoted -cmdline argument
+  # Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4.
+  # Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
+  *-cmdline\ * | *-ignore\ * | *-def\ *)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed "\
+	s/-cmdline  *'[^']*'/ /g; s/-cmdline  *\"[^\"]*\"/ /g
+	s/-ignore  *'[^']*'/ /g; s/-ignore  *\"[^\"]*\"/ /g
+	s/-def  *'[^']*'/ /g; s/-def  *\"[^\"]*\"/ /g"` ;;
+
+  # If we are using Cray Fortran then delete quotes.
+  *cft90*)
+    ac_fc_v_output=`echo $ac_fc_v_output | sed 's/"//g'` ;;
+esac
+
+
+
+ac_cv_fc_libs=
+
+# Save positional arguments (if any)
+ac_save_positional="$@"
+
+set X $ac_fc_v_output
+while test $# != 1; do
+  shift
+  ac_arg=$1
+  case $ac_arg in
+	[\\/]*.a | ?:[\\/]*.a)
+	    ac_exists=false
+  for ac_i in $ac_cv_fc_libs; do
+    if test x"$ac_arg" = x"$ac_i"; then
+      ac_exists=true
+      break
+    fi
+  done
+
+  if test x"$ac_exists" = xtrue; then :
+
+else
+  ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+fi
+	  ;;
+	-bI:*)
+	    ac_exists=false
+  for ac_i in $ac_cv_fc_libs; do
+    if test x"$ac_arg" = x"$ac_i"; then
+      ac_exists=true
+      break
+    fi
+  done
+
+  if test x"$ac_exists" = xtrue; then :
+
+else
+  if test "$ac_compiler_gnu" = yes; then
+  for ac_link_opt in $ac_arg; do
+    ac_cv_fc_libs="$ac_cv_fc_libs -Xlinker $ac_link_opt"
+  done
+else
+  ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+fi
+fi
+	  ;;
+	  # Ignore these flags.
+	-lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \
+	  |-LANG:=* | -LIST:* | -LNO:* | -link | -list | -lnuma )
+	  ;;
+	-lkernel32)
+	  test x"$CYGWIN" != xyes && ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+	  ;;
+	-[LRuYz])
+	  # These flags, when seen by themselves, take an argument.
+	  # We remove the space between option and argument and re-iterate
+	  # unless we find an empty arg or a new option (starting with -)
+	  case $2 in
+	     "" | -*);;
+	     *)
+		ac_arg="$ac_arg$2"
+		shift; shift
+		set X $ac_arg "$@"
+		;;
+	  esac
+	  ;;
+	-YP,*)
+	  for ac_j in `$as_echo "$ac_arg" | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do
+	      ac_exists=false
+  for ac_i in $ac_cv_fc_libs; do
+    if test x"$ac_j" = x"$ac_i"; then
+      ac_exists=true
+      break
+    fi
+  done
+
+  if test x"$ac_exists" = xtrue; then :
+
+else
+  ac_arg="$ac_arg $ac_j"
+			       ac_cv_fc_libs="$ac_cv_fc_libs $ac_j"
+fi
+	  done
+	  ;;
+	-[lLR]*)
+	    ac_exists=false
+  for ac_i in $ac_cv_fc_libs; do
+    if test x"$ac_arg" = x"$ac_i"; then
+      ac_exists=true
+      break
+    fi
+  done
+
+  if test x"$ac_exists" = xtrue; then :
+
+else
+  ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+fi
+	  ;;
+	-zallextract*| -zdefaultextract)
+	  ac_cv_fc_libs="$ac_cv_fc_libs $ac_arg"
+	  ;;
+	  # Ignore everything else.
+  esac
+done
+# restore positional arguments
+set X $ac_save_positional; shift
+
+# We only consider "LD_RUN_PATH" on Solaris systems.  If this is seen,
+# then we insist that the "run path" must be an absolute path (i.e. it
+# must begin with a "/").
+case `(uname -sr) 2>/dev/null` in
+   "SunOS 5"*)
+      ac_ld_run_path=`$as_echo "$ac_fc_v_output" |
+			sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'`
+      test "x$ac_ld_run_path" != x &&
+	if test "$ac_compiler_gnu" = yes; then
+  for ac_link_opt in $ac_ld_run_path; do
+    ac_cv_fc_libs="$ac_cv_fc_libs -Xlinker $ac_link_opt"
+  done
+else
+  ac_cv_fc_libs="$ac_cv_fc_libs $ac_ld_run_path"
+fi
+      ;;
+esac
+fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_libs" >&5
+$as_echo "$ac_cv_fc_libs" >&6; }
+FCLIBS="$ac_cv_fc_libs"
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dummy main to link with Fortran libraries" >&5
+$as_echo_n "checking for dummy main to link with Fortran libraries... " >&6; }
+if test "${ac_cv_fc_dummy_main+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  ac_fc_dm_save_LIBS=$LIBS
+ LIBS="$LIBS $FCLIBS"
+ ac_fortran_dm_var=FC_DUMMY_MAIN
+ ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ # First, try linking without a dummy main:
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+#ifdef FC_DUMMY_MAIN
+#ifndef FC_DUMMY_MAIN_EQ_F77
+#  ifdef __cplusplus
+     extern "C"
+#  endif
+   int FC_DUMMY_MAIN() { return 1; }
+#endif
+#endif
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_fortran_dummy_main=none
+else
+  ac_cv_fortran_dummy_main=unknown
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+
+ if test $ac_cv_fortran_dummy_main = unknown; then
+   for ac_func in MAIN__ MAIN_ __main MAIN _MAIN __MAIN main_ main__ _main; do
+     cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+#define $ac_fortran_dm_var $ac_func
+#ifdef FC_DUMMY_MAIN
+#ifndef FC_DUMMY_MAIN_EQ_F77
+#  ifdef __cplusplus
+     extern "C"
+#  endif
+   int FC_DUMMY_MAIN() { return 1; }
+#endif
+#endif
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_fortran_dummy_main=$ac_func; break
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+   done
+ fi
+ ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+ ac_cv_fc_dummy_main=$ac_cv_fortran_dummy_main
+ rm -rf conftest*
+ LIBS=$ac_fc_dm_save_LIBS
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_dummy_main" >&5
+$as_echo "$ac_cv_fc_dummy_main" >&6; }
+FC_DUMMY_MAIN=$ac_cv_fc_dummy_main
+if test "$FC_DUMMY_MAIN" != unknown; then :
+  if test $FC_DUMMY_MAIN != none; then
+
+cat >>confdefs.h <<_ACEOF
+#define FC_DUMMY_MAIN $FC_DUMMY_MAIN
+_ACEOF
+
+  if test "x$ac_cv_fc_dummy_main" = "x$ac_cv_f77_dummy_main"; then
+
+$as_echo "#define FC_DUMMY_MAIN_EQ_F77 1" >>confdefs.h
+
+  fi
+fi
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "linking to Fortran libraries from C fails
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran name-mangling scheme" >&5
+$as_echo_n "checking for Fortran name-mangling scheme... " >&6; }
+if test "${ac_cv_fc_mangling+set}" = set; then :
+  $as_echo_n "(cached) " >&6
+else
+  cat > conftest.$ac_ext <<_ACEOF
+      subroutine foobar()
+      return
+      end
+      subroutine foo_bar()
+      return
+      end
+_ACEOF
+if ac_fn_fc_try_compile "$LINENO"; then :
+  mv conftest.$ac_objext cfortran_test.$ac_objext
+
+  ac_save_LIBS=$LIBS
+  LIBS="cfortran_test.$ac_objext $LIBS $FCLIBS"
+
+  ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+  ac_success=no
+  for ac_foobar in foobar FOOBAR; do
+    for ac_underscore in "" "_"; do
+      ac_func="$ac_foobar$ac_underscore"
+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $ac_func ();
+#ifdef FC_DUMMY_MAIN
+#ifndef FC_DUMMY_MAIN_EQ_F77
+#  ifdef __cplusplus
+     extern "C"
+#  endif
+   int FC_DUMMY_MAIN() { return 1; }
+#endif
+#endif
+int
+main ()
+{
+return $ac_func ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_success=yes; break 2
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    done
+  done
+  ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+  if test "$ac_success" = "yes"; then
+     case $ac_foobar in
+	foobar)
+	   ac_case=lower
+	   ac_foo_bar=foo_bar
+	   ;;
+	FOOBAR)
+	   ac_case=upper
+	   ac_foo_bar=FOO_BAR
+	   ;;
+     esac
+
+     ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+     ac_success_extra=no
+     for ac_extra in "" "_"; do
+	ac_func="$ac_foo_bar$ac_underscore$ac_extra"
+	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $ac_func ();
+#ifdef FC_DUMMY_MAIN
+#ifndef FC_DUMMY_MAIN_EQ_F77
+#  ifdef __cplusplus
+     extern "C"
+#  endif
+   int FC_DUMMY_MAIN() { return 1; }
+#endif
+#endif
+int
+main ()
+{
+return $ac_func ();
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_success_extra=yes; break
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+     done
+     ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+
+     if test "$ac_success_extra" = "yes"; then
+	ac_cv_fc_mangling="$ac_case case"
+	if test -z "$ac_underscore"; then
+	   ac_cv_fc_mangling="$ac_cv_fc_mangling, no underscore"
+	else
+	   ac_cv_fc_mangling="$ac_cv_fc_mangling, underscore"
+	fi
+	if test -z "$ac_extra"; then
+	   ac_cv_fc_mangling="$ac_cv_fc_mangling, no extra underscore"
+	else
+	   ac_cv_fc_mangling="$ac_cv_fc_mangling, extra underscore"
+	fi
+      else
+	ac_cv_fc_mangling="unknown"
+      fi
+  else
+     ac_cv_fc_mangling="unknown"
+  fi
+
+  LIBS=$ac_save_LIBS
+  rm -rf conftest*
+  rm -f cfortran_test*
+else
+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error "cannot compile a simple Fortran program
+See \`config.log' for more details." "$LINENO" 5; }
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_fc_mangling" >&5
+$as_echo "$ac_cv_fc_mangling" >&6; }
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_ext=${ac_fc_srcext-f}
+ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
+ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_fc_compiler_gnu
+case $ac_cv_fc_mangling in
+  "lower case, no underscore, no extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) name" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) name" >>confdefs.h
+ ;;
+  "lower case, no underscore, extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) name" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) name ## _" >>confdefs.h
+ ;;
+  "lower case, underscore, no extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) name ## _" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) name ## _" >>confdefs.h
+ ;;
+  "lower case, underscore, extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) name ## _" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) name ## __" >>confdefs.h
+ ;;
+  "upper case, no underscore, no extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) NAME" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) NAME" >>confdefs.h
+ ;;
+  "upper case, no underscore, extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) NAME" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) NAME ## _" >>confdefs.h
+ ;;
+  "upper case, underscore, no extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) NAME ## _" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) NAME ## _" >>confdefs.h
+ ;;
+  "upper case, underscore, extra underscore")
+	  $as_echo "#define FC_FUNC(name,NAME) NAME ## _" >>confdefs.h
+
+	  $as_echo "#define FC_FUNC_(name,NAME) NAME ## __" >>confdefs.h
+ ;;
+  *)
+	  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unknown Fortran name-mangling scheme" >&5
+$as_echo "$as_me: WARNING: unknown Fortran name-mangling scheme" >&2;}
+	  ;;
+esac
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+FC="$OLDFC"
+
+# CHECK THAT THE FORTRAN COMPILER CAN CORRECTLY PROCESS THESE DIRECTIVES
+# IF NOT, USE THE EXTERNAL C PREPROCESSOR
+OLDFC="$FC"
+
+defineflag="-Daardvark"
+if test "$OLDFC" = "xlf90"; then
+   defineflag="-WF,-Daardvark"
+fi
+if test "$OLDFC" = "frt"; then
+   defineflag="-Wp,-Daardvark"
+fi
+
+FC="$OLDFC"
+
+# DEFINE VARIABLES ACCORDING TO OS AND COMPILER
+
+echo "Hostname=$ac_hostname"
+echo "Machine=$machinename"
+echo "OS=$osname"
+
+# CHECK OS NAME
+if echo $osname | grep -i aix >/dev/null 2>&1; then
+   SYSDEF="AIX"
+fi
+if echo $osname | grep -i darwin >/dev/null 2>&1; then
+   SYSDEF="DARWIN"
+fi
+if echo $osname | grep -i unix_system_v >/dev/null 2>&1; then
+   SYSDEF="UNIXSYSTEMV"
+fi
+if echo $osname | grep -i irix >/dev/null 2>&1; then
+   SYSDEF="IRIX"
+fi
+if echo $osname | grep -i irix64 >/dev/null 2>&1; then
+   SYSDEF="IRIX64"
+fi
+if echo $osname | grep -i linux >/dev/null 2>&1; then
+   SYSDEF="LINUX"
+fi
+if echo $osname | grep -i osf1 >/dev/null 2>&1; then
+   SYSDEF="OSF1"
+fi
+if echo $osname | grep -i super >/dev/null 2>&1; then
+   SYSDEF="SUPERUX"
+fi
+if echo $osname | grep -i sun >/dev/null 2>&1; then
+   SYSDEF="SUNOS"
+fi
+if echo $osname | grep -i t3e >/dev/null 2>&1; then
+   SYSDEF="T3E"
+fi
+if echo $osname | grep -i unicos >/dev/null 2>&1; then
+   SYSDEF="UNICOS"
+fi
+if test -z "$SYSDEF"; then
+   { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: OPERATING SYSTEM UNKNOWN" >&5
+$as_echo "$as_me: WARNING: OPERATING SYSTEM UNKNOWN" >&2;}
+   SYSDEF="UNKNOWNOS"
+fi
+
+# Set the default FCFLAGS for non-gfortran compilers.
+# NOTE:  This may change with a new version of autoconf.
+DEFFCFLAGS="-g"
+
+#####################################################
+# CHECK COMPILER NAME and add specific flags
+if echo $FC | grep xlf >/dev/null 2>&1; then
+   echo "Fortran Compiler is XLF"
+   CPRDEF="XLF"
+   if test -z "$REAL8"; then
+      REAL8="-qrealsize=8"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2 -qarch=auto"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-qdbg"
+   fi
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+       FCFLAGS=""
+   fi
+elif echo $FC | grep pgf >/dev/null 2>&1; then
+   echo "Fortran Compiler is Portland Group"
+   CPRDEF="PGI"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-pc 64"
+   fi
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS=""
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-byteswapio"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+elif echo $FC | grep ftn >/dev/null 2>&1; then
+ if echo $ac_fc_version_output | grep -i Portland >/dev/null 2>&1; then
+   echo "Fortran Compiler is Portland Group, Cray"
+   CPRDEF="PGI"
+   SYSDEF="CNLINUX"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-pc 64"
+   fi
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS=""
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-byteswapio"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+ fi
+elif echo $FC | grep ifort >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel ifort"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS="-w -ftz"
+   fi
+   if test -z "$PROGFCFLAGS"; then
+      PROGFCFLAGS="-assume byterecl"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+elif echo $FC | grep g95 >/dev/null 2>&1; then
+   echo "Fortran Compiler is GNU"
+   CPRDEF="GNU"
+elif echo $FC | grep gfortran >/dev/null 2>&1; then
+   echo "Fortran Compiler is GNU"
+   CPRDEF="GNU"
+# For gfortran, default flags are different
+   if test "$FCFLAGS" = "-g -O2"; then
+      FCFLAGS=""
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+###########################################################
+# the compiler flags below have not been verified recently
+###########################################################
+elif echo $FC | grep frt >/dev/null 2>&1; then
+   echo "Fortran Compiler is UXP/V"
+   echo "Suggested additional vectorization flags: -Wv,-s5,-t3,-noalias,-ilfunc,-md"
+   CPRDEF="FUJITSU"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-Am -X9"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-KA64"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-Ad"
+   fi
+elif echo $ac_fc_version_output | grep Lahey >/dev/null 2>&1; then
+   echo "Fortran Compiler is Lahey"
+   CPRDEF="LAHEY"
+elif echo $FC | grep ifc >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel 7.x or earlier"
+   echo "Intel ifc compiler must set the environment variable F_UFMTENDIAN=big to do endian conversion"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-w"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $FC | grep efc >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel 7.x or earlier for IA-64"
+   echo "Intel efc compiler must set the environment variable F_UFMTENDIAN=big to do endian conversion"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-w -ftz"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $FC | grep pathf90 >/dev/null 2>&1; then
+   echo "Fortran Compiler is PathScale"
+   CPRDEF="PATHSC"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-m64"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i nag >/dev/null 2>&1; then
+   echo "Fortran Compiler is NAG"
+   CPRDEF="NAG"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-dusty -kind=byte"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i absoft >/dev/null 2>&1; then
+   echo "Fortran Compiler is Absoft"
+   CPRDEF="ABSOFT"
+   if test -z "$REAL8"; then
+      REAL8="-N113"
+   fi
+   if test -z "$INCLUDEFLAG"; then
+      INCLUDEFLAG="-p"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i workshop >/dev/null 2>&1; then
+   echo "Fortran Compiler is Workshop"
+   CPRDEF="WORKSHOP"
+   if test -z "$INCLUDEFLAG"; then
+      INCLUDEFLAG="-M"
+   fi
+elif echo $ac_fc_version_output | grep -i mipspro >/dev/null 2>&1; then
+   echo "Fortran Compiler is MIPSPro"
+   CPRDEF="MIPSPRO"
+   EXTRACFLAGS="-64"
+   if test -z "$OPT"; then
+      OPT="-O3"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-64"
+   fi
+elif echo $ac_fc_version_output | grep -i compaq >/dev/null 2>&1; then
+   echo "Fortran Compiler is Compaq"
+   CPRDEF="COMPAQ"
+   MPILIBS="$MPILIBS -lelan"
+   if test -z "$OPT"; then
+      OPT="-fast"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-real_size 64"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+
+# Compaq Fortran changed its name to HP Fortran.
+# Lets support both versions for now.
+elif echo $ac_fc_version_output | grep HP >/dev/null 2>&1; then
+   echo "Fortran Compiler is HP"
+   CPRDEF="COMPAQ"
+   MPILIBS="$MPILIBS -lelan"
+   if test -z "$OPT"; then
+      OPT="-fast"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-real_size 64"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+
+elif echo $ac_fc_version_output | grep -i sx >/dev/null 2>&1; then
+   echo "Fortran Compiler is SX"
+   CPRDEF="SX"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-EP -Wf'-pvctl noassoc'"
+   fi
+   if test -z "$OPT"; then
+      OPT="-Chopt"
+   fi
+fi
+
+###########################################################
+# END of compiler-specific flag setting
+###########################################################
+
+CPPDEFS="$CPPDEFS -DSYS$SYSDEF -DCPR$CPRDEF"
+if test -n "$SRKDEF"; then
+    CPPDEFS="$CPPDEFS -D$SRKDEF"
+fi
+
+# IF DEBUGGING ENABLED, DISABLE OPTIMIZATION FLAG
+if test "$DEBUGGING" = "ENABLED"; then
+        OPT=""
+else
+        DEBUG=""
+fi
+
+# SET HARDCODED VARIABLES AS A LAST RESORT
+
+# ALWAYS ENABLE CRULE IN MAKEFILE
+CRULE=.c.o
+
+
+
+
+# INCLUDE FLAG IF NOT ALREADY SET IS MOST LIKELY -I
+if test -z "$INCLUDEFLAG"; then
+   INCLUDEFLAG="-I"
+fi
+
+# ARCHIVE COMMAND SIMILAR ACROSS ALL PLATFORMS
+if test -z "$AR"; then
+   AR="ar cq"
+fi
+
+echo
+echo Output Variables: {CC=$CC} {CFLAGS=$CFLAGS} \
+{FC=$FC} {FCFLAGS=$FCFLAGS} {PROGFCFLAGS=$PROGFCFLAGS}\
+{CPPDEFS=$CPPDEFS} {OPT=$OPT} {DEBUG=$DEBUG} {REAL8=$REAL8} \
+{BIT64=$BIT64} {ENDIAN=$ENDIAN} {MPIFC=$MPIFC} \
+{MPILIBS=$MPILIBS} {MPIHEADER=$MPIHEADER}  \
+{INCLUDEFLAG=$INCLUDEFLAG} {INCLUDEPATH=$INCLUDEPATH} \
+{AR=$AR} {BABELROOT=$BABELROOT} {COMPILER_ROOT=$COMPILER_ROOT} \
+{PYTHON=$PYTHON} {PYTHONOPTS=$PYTHONOPTS} {FORT_SIZE=$FORT_SIZE} {prefix=$prefix} \
+{SRCDIR=$SRCDIR} {FC_DEFINE=$FC_DEFINE}
+echo
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+      *) { eval $ac_var=; unset $ac_var;} ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes: double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \.
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    test "x$cache_file" != "x/dev/null" &&
+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+    cat confcache >$cache_file
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_write_fail=0
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+  emulate sh
+  NULLCMD=:
+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in #(
+  *posix*) :
+    set -o posix ;; #(
+  *) :
+     ;;
+esac
+fi
+
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='print -r --'
+  as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+  as_echo='printf %s\n'
+  as_echo_n='printf %s'
+else
+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+    as_echo_n='/usr/ucb/echo -n'
+  else
+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+    as_echo_n_body='eval
+      arg=$1;
+      case $arg in #(
+      *"$as_nl"*)
+	expr "X$arg" : "X\\(.*\\)$as_nl";
+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+      esac;
+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+    '
+    export as_echo_n_body
+    as_echo_n='sh -c $as_echo_n_body as_echo'
+  fi
+  export as_echo_body
+  as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+      PATH_SEPARATOR=';'
+  }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in #((
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+  done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there.  '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error ERROR [LINENO LOG_FD]
+# ---------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with status $?, using 1 if that was 0.
+as_fn_error ()
+{
+  as_status=$?; test $as_status -eq 0 && as_status=1
+  if test "$3"; then
+    as_lineno=${as_lineno-"$2"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $1" >&$3
+  fi
+  $as_echo "$as_me: error: $1" >&2
+  as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+  return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+  set +e
+  as_fn_set_status $1
+  exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+  { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+  eval 'as_fn_append ()
+  {
+    eval $1+=\$2
+  }'
+else
+  as_fn_append ()
+  {
+    eval $1=\$$1\$2
+  }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+  eval 'as_fn_arith ()
+  {
+    as_val=$(( $* ))
+  }'
+else
+  as_fn_arith ()
+  {
+    as_val=`expr "$@" || test $? -eq 1`
+  }
+fi # as_fn_arith
+
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+  case `echo 'xy\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  xy)  ECHO_C='\c';;
+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
+       ECHO_T='	';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir 2>/dev/null
+fi
+if (echo >conf$$.file) 2>/dev/null; then
+  if ln -s conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s='ln -s'
+    # ... but there are two gotchas:
+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+    # In both cases, we have to default to `cp -p'.
+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+      as_ln_s='cp -p'
+  elif ln conf$$.file conf$$ 2>/dev/null; then
+    as_ln_s=ln
+  else
+    as_ln_s='cp -p'
+  fi
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || eval $as_mkdir_p || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || as_fn_error "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p='mkdir -p "$as_dir"'
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+	test -d "$1/.";
+      else
+	case $1 in #(
+	-*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling.
+ac_log="
+This file was extended by MCT $as_me 2.8, which was
+generated by GNU Autoconf 2.65.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
+
+case $ac_config_headers in *"
+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;
+esac
+
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
+config_headers="$ac_config_headers"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+ac_cs_usage="\
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration.  Unless the files
+and actions are specified as TAGs, all are instantiated by default.
+
+Usage: $0 [OPTION]... [TAG]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+      --config     print configuration, then exit
+  -q, --quiet, --silent
+                   do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+      --file=FILE[:TEMPLATE]
+                   instantiate the configuration file FILE
+      --header=FILE[:TEMPLATE]
+                   instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Report bugs to the package provider."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
+ac_cs_version="\\
+MCT config.status 2.8
+configured by $0, generated by GNU Autoconf 2.65,
+  with options \\"\$ac_cs_config\\"
+
+Copyright (C) 2009 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    $as_echo "$ac_cs_version"; exit ;;
+  --config | --confi | --conf | --con | --co | --c )
+    $as_echo "$ac_cs_config"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --file | --fil | --fi | --f )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_FILES " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    case $ac_optarg in
+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    as_fn_error "ambiguous option: \`$1'
+Try \`$0 --help' for more information.";;
+  --help | --hel | -h )
+    $as_echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) as_fn_error "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
+
+  *) as_fn_append ac_config_targets " $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+if \$ac_cs_recheck; then
+  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+  shift
+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+  CONFIG_SHELL='$SHELL'
+  export CONFIG_SHELL
+  exec "\$@"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  $as_echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "Makefile.conf") CONFIG_FILES="$CONFIG_FILES Makefile.conf" ;;
+    "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
+
+  *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp=
+  trap 'exit_status=$?
+  { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
+' 0
+  trap 'as_fn_exit 1' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -n "$tmp" && test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} || as_fn_error "cannot create a temporary directory in ." "$LINENO" 5
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+  eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+  ac_cs_awk_cr='\r'
+else
+  ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$tmp/subs1.awk" &&
+_ACEOF
+
+
+{
+  echo "cat >conf$$subs.awk <<_ACEOF" &&
+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+  echo "_ACEOF"
+} >conf$$subs.sh ||
+  as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+  . ./conf$$subs.sh ||
+    as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
+
+  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+  if test $ac_delim_n = $ac_delim_num; then
+    break
+  elif $ac_last_try; then
+    as_fn_error "could not make $CONFIG_STATUS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+  N
+  s/\n//
+}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$tmp/subs1.awk" <<_ACAWK &&
+  for (key in S) S_is_set[key] = 1
+  FS = ""
+
+}
+{
+  line = $ 0
+  nfields = split(line, field, "@")
+  substed = 0
+  len = length(field[1])
+  for (i = 2; i < nfields; i++) {
+    key = field[i]
+    keylen = length(key)
+    if (S_is_set[key]) {
+      value = S[key]
+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+      len += length(value) + length(field[++i])
+      substed = 1
+    } else
+      len += 1 + keylen
+  }
+
+  print line
+}
+
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+  cat
+fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \
+  || as_fn_error "could not setup config files machinery" "$LINENO" 5
+_ACEOF
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{
+s/:*\$(srcdir):*/:/
+s/:*\${srcdir}:*/:/
+s/:*@srcdir@:*/:/
+s/^\([^=]*=[	 ]*\):*/\1/
+s/:*$//
+s/^[^=]*=[	 ]*$//
+}'
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
+
+# Set up the scripts for CONFIG_HEADERS section.
+# No need to generate them if there are no CONFIG_HEADERS.
+# This happens for instance with `./config.status Makefile'.
+if test -n "$CONFIG_HEADERS"; then
+cat >"$tmp/defines.awk" <<\_ACAWK ||
+BEGIN {
+_ACEOF
+
+# Transform confdefs.h into an awk script `defines.awk', embedded as
+# here-document in config.status, that substitutes the proper values into
+# config.h.in to produce config.h.
+
+# Create a delimiter string that does not exist in confdefs.h, to ease
+# handling of long lines.
+ac_delim='%!_!# '
+for ac_last_try in false false :; do
+  ac_t=`sed -n "/$ac_delim/p" confdefs.h`
+  if test -z "$ac_t"; then
+    break
+  elif $ac_last_try; then
+    as_fn_error "could not make $CONFIG_HEADERS" "$LINENO" 5
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+# For the awk script, D is an array of macro values keyed by name,
+# likewise P contains macro parameters if any.  Preserve backslash
+# newline sequences.
+
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+sed -n '
+s/.\{148\}/&'"$ac_delim"'/g
+t rset
+:rset
+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /
+t def
+d
+:def
+s/\\$//
+t bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3"/p
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p
+d
+:bsnl
+s/["\\]/\\&/g
+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\
+D["\1"]=" \3\\\\\\n"\\/p
+t cont
+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p
+t cont
+d
+:cont
+n
+s/.\{148\}/&'"$ac_delim"'/g
+t clear
+:clear
+s/\\$//
+t bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/"/p
+d
+:bsnlc
+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p
+b cont
+' <confdefs.h | sed '
+s/'"$ac_delim"'/"\\\
+"/g' >>$CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  for (key in D) D_is_set[key] = 1
+  FS = ""
+}
+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {
+  line = \$ 0
+  split(line, arg, " ")
+  if (arg[1] == "#") {
+    defundef = arg[2]
+    mac1 = arg[3]
+  } else {
+    defundef = substr(arg[1], 2)
+    mac1 = arg[2]
+  }
+  split(mac1, mac2, "(") #)
+  macro = mac2[1]
+  prefix = substr(line, 1, index(line, defundef) - 1)
+  if (D_is_set[macro]) {
+    # Preserve the white space surrounding the "#".
+    print prefix "define", macro P[macro] D[macro]
+    next
+  } else {
+    # Replace #undef with comments.  This is necessary, for example,
+    # in the case of _POSIX_SOURCE, which is predefined and required
+    # on some systems where configure will not decide to define it.
+    if (defundef == "undef") {
+      print "/*", prefix defundef, macro, "*/"
+      next
+    }
+  }
+}
+{ print }
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+  as_fn_error "could not setup config headers machinery" "$LINENO" 5
+fi # test -n "$CONFIG_HEADERS"
+
+
+eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "
+shift
+for ac_tag
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) as_fn_error "invalid tag \`$ac_tag'" "$LINENO" 5;;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   as_fn_error "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+      esac
+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+      as_fn_append ac_file_inputs " '$ac_f'"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input='Generated from '`
+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+	`' by configure.'
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
+    fi
+    # Neutralize special characters interpreted by sed in replacement strings.
+    case $configure_input in #(
+    *\&* | *\|* | *\\* )
+       ac_sed_conf_input=`$as_echo "$configure_input" |
+       sed 's/[\\\\&|]/\\\\&/g'`;; #(
+    *) ac_sed_conf_input=$configure_input;;
+    esac
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$tmp/stdin" \
+      || as_fn_error "could not create $ac_file" "$LINENO" 5 ;;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  as_dir="$ac_dir"; as_fn_mkdir_p
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+  :F)
+  #
+  # CONFIG_FILE
+  #
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+  p
+  q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+  ac_datarootdir_hack='
+  s&@datadir@&$datadir&g
+  s&@docdir@&$docdir&g
+  s&@infodir@&$infodir&g
+  s&@localedir@&$localedir&g
+  s&@mandir@&$mandir&g
+  s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
+_ACEOF
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \
+  || as_fn_error "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+  { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&
+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined." >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined." >&2;}
+
+  rm -f "$tmp/stdin"
+  case $ac_file in
+  -) cat "$tmp/out" && rm -f "$tmp/out";;
+  *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;
+  esac \
+  || as_fn_error "could not create $ac_file" "$LINENO" 5
+ ;;
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+  if test x"$ac_file" != x-; then
+    {
+      $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"
+    } >"$tmp/config.h" \
+      || as_fn_error "could not create $ac_file" "$LINENO" 5
+    if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5
+$as_echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f "$ac_file"
+      mv "$tmp/config.h" "$ac_file" \
+	|| as_fn_error "could not create $ac_file" "$LINENO" 5
+    fi
+  else
+    $as_echo "/* $configure_input  */" \
+      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \
+      || as_fn_error "could not create -" "$LINENO" 5
+  fi
+ ;;
+
+
+  esac
+
+done # for ac_tag
+
+
+as_fn_exit 0
+_ACEOF
+ac_clean_files=$ac_clean_files_save
+
+test $ac_write_fail = 0 ||
+  as_fn_error "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || as_fn_exit $?
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
+fi
+
+
+echo Please check the Makefile.conf
+echo Have a nice day!
+
+# test -z is true for empty strings
+# test -n is true for non-empty strings
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure.ac
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure.ac	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/configure.ac	(revision 4775)
@@ -0,0 +1,585 @@
+#                                               -*- Autoconf -*-
+# Process this file with autoconf to produce a configure script.
+
+AC_INIT(MCT, 2.8)
+
+# PROCESS THE FOLLOWING MAKEFILES
+AC_CONFIG_MACRO_DIR([m4])
+AC_CONFIG_FILES(Makefile.conf)
+AC_CONFIG_HEADER(config.h)
+
+# DECLARE PACKAGE OPTIONS
+
+AC_ARG_ENABLE(mpiserial,
+AC_HELP_STRING([--enable-mpiserial],
+[Use the included MPI replacement library for single processor]),
+[DONOTCHECKMPI="DONOTCHECKMPI"]
+)
+
+AC_ARG_ENABLE(debugging,
+AC_HELP_STRING([--enable-debugging],
+[Use the debugging flag and disable the optimization flag]),
+[DEBUGGING="ENABLED"]
+)
+
+AC_ARG_ENABLE(selectedrealkind,
+AC_HELP_STRING([--enable-selectedrealkind],
+[define single precision and double precision numbers using the selected_real_kind function. Default uses the kind inquiry function.]),
+[SRKDEF="SELECTEDREALKIND"]
+)
+
+AC_ARG_ENABLE(sequence,
+AC_HELP_STRING([--enable-sequence],[Modify MCT types to make them contiguous in memory.]),
+[SRKDEF="SEQUENCE"],)
+
+AC_ARG_ENABLE(babel,
+AC_HELP_STRING([--enable-babel],[Supply this option if you plan on building the Babel bindings to MCT]),
+[SRKDEF="SEQUENCE"],)
+
+
+
+# DECLARE THE FOLLOWING PRECIOUS VARIABLES
+
+AC_ARG_VAR(MPILIBS,[MPI library command line invocation])
+AC_ARG_VAR(MPIHEADER,[MPI header include path with INCLUDEFLAG])
+AC_ARG_VAR(FPP,C-preprocessor for Fortran source code)
+AC_ARG_VAR(FPPFLAGS,C-preprocessing flags for Fortran source code)
+AC_ARG_VAR(FC,The Fortran compiler)
+AC_ARG_VAR(FCFLAGS,User-defined Fortran compiler flags)
+AC_ARG_VAR(PROGFCFLAGS,User-defined Fortran compiler flags for example programs)
+AC_ARG_VAR(CFLAGS,Customized C source compilation flags)
+AC_ARG_VAR(DEBUG,Fortran compiler flag for generating symbolic debugging information)
+AC_ARG_VAR(OPT,Fortran compiler flag for optimization level) 
+AC_ARG_VAR(REAL8,[Fortran compiler flag for setting the default REAL size to REAL(KIND=8)])
+AC_ARG_VAR(BIT64,Fortran compiler flag for generating 64-bit objects)
+AC_ARG_VAR(ENDIAN,Fortran compiler flag for converting big-endian to little-endian)
+AC_ARG_VAR(INCLUDEFLAG,Fortran compiler flag for specifying module search path)
+AC_ARG_VAR(INCLUDEPATH,Additional library and module paths with INCLUDEFLAG)
+AC_ARG_VAR(AR,Archive command)
+AC_ARG_VAR(BABELROOT,Root directory of your Babel installation. i.e.: $BABELROOT/bin/babel $BABELROOT/lib/libsidl.so)
+AC_ARG_VAR(COMPILER_ROOT,Root directory of your FORTRAN compiler)
+AC_ARG_VAR(FORT_SIZE, Number of bits in Fortran real and double kind)
+
+# INCLUDE BABELROOT and COMPILER_ROOT in Makefile.conf(autoconf output)
+AC_SUBST(BABELROOT)
+AC_SUBST(COMPILER_ROOT)
+AC_SUBST(PYTHON)
+AC_SUBST(PYTHONOPTS)
+
+# SET TEMPORARY VARIABLES
+
+# OS AND PLATFORM NAME
+test "$osname"=NONE && osname=`uname -s`
+test "$machinename"=NONE && machinename=`uname -m`
+fullhostname=`hostname -f`
+
+
+# HARDCODE SPECIFIC MACHINES FOR EXTRAORDINARY CIRCUMSTANCES
+
+# CHECK IF WE ARE ON THE EARTH SIMULATOR
+ES="NO"
+if echo $osname | grep -i esos >/dev/null 2>&1; then
+   ES="YES"
+fi
+if echo $osname | grep -i hp-ux >/dev/null 2>&1; then   
+   if test "$ac_hostname" = "moon"; then 
+      ES="YES"
+      # TELLS CONFIGURE NOT TO RUN ANY TESTS THAT REQUIRE EXECUTION
+      cross_compiling="yes"
+   fi
+fi
+if test "$ES" = "YES"; then   
+   echo "Using preset configuration values for the Earth Simulator"
+   if test -z "$CC"; then
+      CC="escc"
+   fi
+   if test -z "$FC"; then
+      FC="esf90"
+   fi
+   if test -z "$MPIFC"; then
+      MPIFC="esmpif90"
+   fi
+   if test -z "$AR"; then
+      AR="esar cqs"
+   fi
+   if test -z "FPP"; then
+      FPPFLAGS=" "
+   fi
+   if test -z "$FCFLAGS"; then
+      FCFLAGS="-EP -Wf'-pvctl fullmsg -L fmtlist transform map'"
+   fi
+   if test -z "$OPT"; then
+      OPT="-C vopt"
+   fi      
+   if test -z "$CPPDEFS"; then
+      CPPDEFS="-DESVEC"
+   fi
+fi
+
+# Check if we are on the ANL BG/P
+
+if echo $fullhostname | egrep -q '.\.(challenger|intrepid)\.alcf\.anl\.gov' 
+  then if test -z "$FC"; then
+         FC=bgxlf90_r
+       fi
+       if test -z "$MPIFC"; then
+         MPIFC=mpixlf90_r
+       fi
+       if test -z "$CC"; then
+         CC=mpixlc_r
+       fi
+fi
+
+
+
+# START TESTS
+
+# CHECK FOR THE C COMPILER
+AC_PROG_CC([cc])
+
+# CHECK FOR BYTE ORDERING
+AC_C_BIGENDIAN
+
+# CHECK FOR THE FORTRAN COMPILER
+# RLJ- specify the order, include PathScale and do not search for F77
+AC_PROG_FC([xlf95 pgf95 ifort gfortran pathf95 ftn lf95 f95 fort ifc efc g95 xlf90 pgf90 pathf90 epcf90 pghpf])
+
+# CHECK FOR MPI LIBRARIES
+AC_LANG_PUSH(Fortran)
+
+AC_FC_SRCEXT(F90)
+
+OLDFCFLAGS="$FCFLAGS"
+
+if test -n "$MPIHEADER"; then
+   FCFLAGS="$FCFLAGS $MPIHEADER"
+fi
+
+# CHECK MPI BY DEFAULT
+if test -z "$DONOTCHECKMPI"; then
+   ACX_MPI
+fi
+
+# DONT CHECK MPI IF SERIALMPI OPTION IS ENABLED
+if test -n "$DONOTCHECKMPI"; then
+   echo "MPISERIAL ENABLED: BYPASSING MPI CHECK"
+   if test -z "$MPIFC"; then
+      MPIFC=$FC
+   fi
+   if test -z "$FORT_SIZE"; then
+      FORT_SIZE="real4double8"
+      echo "FORT_SIZE IS PRESET TO $FORT_SIZE"
+   fi   
+   abs_top_builddir=`pwd`
+   MPISERPATH=$abs_top_builddir/mpi-serial
+   AC_SUBST(MPISERPATH)
+   MPIHEADER=-I$MPISERPATH
+   MPILIBS="-L$MPISERPATH -lmpi-serial"
+fi
+
+FCFLAGS="$OLDFCFLAGS"
+
+# A HACK TO FIX ACX_MPI TO GET MPILIBS TO BE AN EMPTY STRING
+if test "$MPILIBS" = " "; then
+   MPILIBS=""
+fi
+
+# SET FC TO MPIFC. IF MPILIBS IS PRESENT, SET FC TO FC.
+if test -z "$FC"; then
+   FC=$MPIFC
+   if test "$FC" != "$MPIFC";  then
+      if test -n "$MPILIBS"; then
+	 FC=$FC
+      fi
+   fi
+fi
+
+# FOR SANITY, CHECK THAT FILENAME EXTENSION FOR FC IS CONSISTENT WITH FC
+OLDFC="$FC"
+FC="$FC"
+
+AC_COMPILE_IFELSE(
+  [       subroutine oof()
+             return 
+          end], [],
+  [AC_MSG_WARN([$FC FAILED TO COMPILE FILENAME EXTENSION $ac_ext])
+  ])
+
+
+
+FC="$OLDFC"
+
+# CHECK HOW TO GET THE COMPILER VERSION.
+echo "Checking Compiler Version"
+AX_FC_VERSION()
+
+AC_LANG_POP(Fortran)
+
+# Check how to use the cpp with fortran
+
+AC_FC_PP_DEFINE()
+
+
+# CHECK HOW TO NAME MANGLE C FUNCTIONS SO THAT IT CAN BE CALLED FROM FORTRAN
+OLDFC="$FC"
+
+AC_FC_WRAPPERS()
+
+FC="$OLDFC"
+
+# CHECK THAT THE FORTRAN COMPILER CAN CORRECTLY PROCESS THESE DIRECTIVES
+# IF NOT, USE THE EXTERNAL C PREPROCESSOR
+OLDFC="$FC"
+
+defineflag="-Daardvark"
+if test "$OLDFC" = "xlf90"; then
+   defineflag="-WF,-Daardvark"
+fi   
+if test "$OLDFC" = "frt"; then
+   defineflag="-Wp,-Daardvark"
+fi
+
+FC="$OLDFC"
+
+# DEFINE VARIABLES ACCORDING TO OS AND COMPILER
+
+echo "Hostname=$ac_hostname"
+echo "Machine=$machinename"
+echo "OS=$osname"
+
+# CHECK OS NAME
+if echo $osname | grep -i aix >/dev/null 2>&1; then
+   SYSDEF="AIX"
+fi
+if echo $osname | grep -i darwin >/dev/null 2>&1; then
+   SYSDEF="DARWIN"
+fi
+if echo $osname | grep -i unix_system_v >/dev/null 2>&1; then
+   SYSDEF="UNIXSYSTEMV"
+fi
+if echo $osname | grep -i irix >/dev/null 2>&1; then
+   SYSDEF="IRIX"
+fi
+if echo $osname | grep -i irix64 >/dev/null 2>&1; then
+   SYSDEF="IRIX64"
+fi
+if echo $osname | grep -i linux >/dev/null 2>&1; then
+   SYSDEF="LINUX"
+fi
+if echo $osname | grep -i osf1 >/dev/null 2>&1; then
+   SYSDEF="OSF1"
+fi
+if echo $osname | grep -i super >/dev/null 2>&1; then
+   SYSDEF="SUPERUX"
+fi
+if echo $osname | grep -i sun >/dev/null 2>&1; then
+   SYSDEF="SUNOS"
+fi
+if echo $osname | grep -i t3e >/dev/null 2>&1; then
+   SYSDEF="T3E"
+fi
+if echo $osname | grep -i unicos >/dev/null 2>&1; then
+   SYSDEF="UNICOS"
+fi
+if test -z "$SYSDEF"; then
+   AC_MSG_WARN([OPERATING SYSTEM UNKNOWN])
+   SYSDEF="UNKNOWNOS"
+fi
+
+# Set the default FCFLAGS for non-gfortran compilers.
+# NOTE:  This may change with a new version of autoconf.
+DEFFCFLAGS="-g"
+
+#####################################################
+# CHECK COMPILER NAME and add specific flags
+if echo $FC | grep xlf >/dev/null 2>&1; then
+   echo "Fortran Compiler is XLF"
+   CPRDEF="XLF"
+   if test -z "$REAL8"; then
+      REAL8="-qrealsize=8"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2 -qarch=auto"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-qdbg"
+   fi
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+       FCFLAGS=""
+   fi
+elif echo $FC | grep pgf >/dev/null 2>&1; then
+   echo "Fortran Compiler is Portland Group"
+   CPRDEF="PGI"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi  
+   if test -z "$BIT64"; then
+      BIT64="-pc 64"
+   fi  
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS=""
+   fi  
+   if test -z "$ENDIAN"; then
+      ENDIAN="-byteswapio"
+   fi  
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi  
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+elif echo $FC | grep ftn >/dev/null 2>&1; then
+ if echo $ac_fc_version_output | grep -i Portland >/dev/null 2>&1; then
+   echo "Fortran Compiler is Portland Group, Cray"
+   CPRDEF="PGI"
+   SYSDEF="CNLINUX"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi  
+   if test -z "$BIT64"; then
+      BIT64="-pc 64"
+   fi  
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS=""
+   fi  
+   if test -z "$ENDIAN"; then
+      ENDIAN="-byteswapio"
+   fi  
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+ fi
+elif echo $FC | grep ifort >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel ifort"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi  
+   if test "$FCFLAGS" = "$DEFFCFLAGS"; then
+      FCFLAGS="-w -ftz"
+   fi  
+   if test -z "$PROGFCFLAGS"; then
+      PROGFCFLAGS="-assume byterecl"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+elif echo $FC | grep g95 >/dev/null 2>&1; then
+   echo "Fortran Compiler is GNU"
+   CPRDEF="GNU"
+elif echo $FC | grep gfortran >/dev/null 2>&1; then
+   echo "Fortran Compiler is GNU"
+   CPRDEF="GNU"
+# For gfortran, default flags are different
+   if test "$FCFLAGS" = "-g -O2"; then
+      FCFLAGS=""
+   fi  
+   if test -z "$DEBUG"; then
+      DEBUG="-g"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+###########################################################
+# the compiler flags below have not been verified recently
+###########################################################
+elif echo $FC | grep frt >/dev/null 2>&1; then
+   echo "Fortran Compiler is UXP/V"
+   echo "Suggested additional vectorization flags: -Wv,-s5,-t3,-noalias,-ilfunc,-md"
+   CPRDEF="FUJITSU"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-Am -X9"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-KA64"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-Ad"
+   fi
+elif echo $ac_fc_version_output | grep Lahey >/dev/null 2>&1; then
+   echo "Fortran Compiler is Lahey"
+   CPRDEF="LAHEY"
+elif echo $FC | grep ifc >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel 7.x or earlier"
+   echo "Intel ifc compiler must set the environment variable F_UFMTENDIAN=big to do endian conversion"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-w"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $FC | grep efc >/dev/null 2>&1; then
+   echo "Fortran Compiler is Intel 7.x or earlier for IA-64"
+   echo "Intel efc compiler must set the environment variable F_UFMTENDIAN=big to do endian conversion"
+   CPRDEF="INTEL"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-w -ftz"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $FC | grep pathf90 >/dev/null 2>&1; then
+   echo "Fortran Compiler is PathScale"
+   CPRDEF="PATHSC"
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-m64"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i nag >/dev/null 2>&1; then
+   echo "Fortran Compiler is NAG"
+   CPRDEF="NAG"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-dusty -kind=byte"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i absoft >/dev/null 2>&1; then
+   echo "Fortran Compiler is Absoft"
+   CPRDEF="ABSOFT"
+   if test -z "$REAL8"; then
+      REAL8="-N113"
+   fi
+   if test -z "$INCLUDEFLAG"; then
+      INCLUDEFLAG="-p"
+   fi
+   if test -z "$OPT"; then
+      OPT="-O2"
+   fi
+elif echo $ac_fc_version_output | grep -i workshop >/dev/null 2>&1; then
+   echo "Fortran Compiler is Workshop"
+   CPRDEF="WORKSHOP"
+   if test -z "$INCLUDEFLAG"; then
+      INCLUDEFLAG="-M"
+   fi
+elif echo $ac_fc_version_output | grep -i mipspro >/dev/null 2>&1; then
+   echo "Fortran Compiler is MIPSPro"
+   CPRDEF="MIPSPRO"
+   EXTRACFLAGS="-64"
+   if test -z "$OPT"; then
+      OPT="-O3"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-r8"
+   fi
+   if test -z "$BIT64"; then
+      BIT64="-64"
+   fi
+elif echo $ac_fc_version_output | grep -i compaq >/dev/null 2>&1; then
+   echo "Fortran Compiler is Compaq"
+   CPRDEF="COMPAQ"
+   MPILIBS="$MPILIBS -lelan"
+   if test -z "$OPT"; then
+      OPT="-fast"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-real_size 64"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+
+# Compaq Fortran changed its name to HP Fortran.
+# Lets support both versions for now.
+elif echo $ac_fc_version_output | grep HP >/dev/null 2>&1; then
+   echo "Fortran Compiler is HP"
+   CPRDEF="COMPAQ"
+   MPILIBS="$MPILIBS -lelan"
+   if test -z "$OPT"; then
+      OPT="-fast"
+   fi
+   if test -z "$REAL8"; then
+      REAL8="-real_size 64"
+   fi
+   if test -z "$ENDIAN"; then
+      ENDIAN="-convert big_endian"
+   fi
+
+elif echo $ac_fc_version_output | grep -i sx >/dev/null 2>&1; then
+   echo "Fortran Compiler is SX"
+   CPRDEF="SX"
+   if test -z "$F90FLAGS"; then
+      F90FLAGS="-EP -Wf'-pvctl noassoc'"
+   fi
+   if test -z "$OPT"; then
+      OPT="-Chopt"
+   fi
+fi
+
+###########################################################
+# END of compiler-specific flag setting
+###########################################################
+
+CPPDEFS="$CPPDEFS -DSYS$SYSDEF -DCPR$CPRDEF"
+if test -n "$SRKDEF"; then
+    CPPDEFS="$CPPDEFS -D$SRKDEF"
+fi
+
+# IF DEBUGGING ENABLED, DISABLE OPTIMIZATION FLAG
+if test "$DEBUGGING" = "ENABLED"; then
+        OPT=""
+else
+        DEBUG=""
+fi
+
+# SET HARDCODED VARIABLES AS A LAST RESORT
+
+# ALWAYS ENABLE CRULE IN MAKEFILE
+AC_SUBST(CRULE,[.c.o])
+
+AC_SUBST(CPPDEFS)
+
+# INCLUDE FLAG IF NOT ALREADY SET IS MOST LIKELY -I
+if test -z "$INCLUDEFLAG"; then
+   INCLUDEFLAG="-I"
+fi
+
+# ARCHIVE COMMAND SIMILAR ACROSS ALL PLATFORMS 
+if test -z "$AR"; then
+   AR="ar cq"
+fi
+
+echo
+echo Output Variables: {CC=$CC} {CFLAGS=$CFLAGS} \
+{FC=$FC} {FCFLAGS=$FCFLAGS} {PROGFCFLAGS=$PROGFCFLAGS}\
+{CPPDEFS=$CPPDEFS} {OPT=$OPT} {DEBUG=$DEBUG} {REAL8=$REAL8} \
+{BIT64=$BIT64} {ENDIAN=$ENDIAN} {MPIFC=$MPIFC} \
+{MPILIBS=$MPILIBS} {MPIHEADER=$MPIHEADER}  \
+{INCLUDEFLAG=$INCLUDEFLAG} {INCLUDEPATH=$INCLUDEPATH} \
+{AR=$AR} {BABELROOT=$BABELROOT} {COMPILER_ROOT=$COMPILER_ROOT} \
+{PYTHON=$PYTHON} {PYTHONOPTS=$PYTHONOPTS} {FORT_SIZE=$FORT_SIZE} {prefix=$prefix} \
+{SRCDIR=$SRCDIR} {FC_DEFINE=$FC_DEFINE}
+echo
+
+AC_OUTPUT
+
+echo Please check the Makefile.conf
+echo Have a nice day!
+
+# test -z is true for empty strings
+# test -n is true for non-empty strings
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+*.toc *.log *.dvi *.aux *.blg *.bbl *.pdf
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/Makefile	(revision 4775)
@@ -0,0 +1,27 @@
+#!/bin/make
+#-----------------------------------------------------------------------
+# Documentation
+all: 
+	cd texsrc; make
+	make apis
+	
+html:
+	latex2html -white -toc_depth 5 -split 4 -show_section_numbers \
+	-address "<A HREF="mailto:jacob@mcs.anl.gov">jacob@mcs.anl.gov</A>" \
+	mct_APIs.tex
+apis:
+	cd texsrc; make
+	make apisdvi
+
+apisdvi: mct_APIs.dvi
+
+clean:
+	cd texsrc; make clean
+	rm -f *.dvi *.log *.bbl *.blg *.aux *.toc
+
+.SUFFIXES: .dvi .tex
+
+.tex.dvi:
+	latex $*.tex
+
+#.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/README	(revision 4775)
@@ -0,0 +1,20 @@
+
+To build the .dvi files for the documentation. type "make".
+
+This will build the API's document.
+
+To build the APIs, type "make apis"
+
+NOTE:  this build system isn't working perfectly yet.  It will
+build a .dvi file but you will need to run "bibtex" manually to
+build the bibliography.
+
+To build "by hand" using the design doc as an example:
+cd to texsrc, type "make"
+cd back to doc directory then do:
+
+latex mct_APIs
+bibtex mct_APIs
+latex mct_APIs
+latex mct_APIs
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/coupler.bib
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/coupler.bib	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/coupler.bib	(revision 4775)
@@ -0,0 +1,254 @@
+@article{gaspari-1999a,
+        author = "G.~Gaspari and S.~E.~Cohn",
+        title = {{Construction of Correlation Functions in Two and Three Dimensions}},
+	journal ={Quart.~J.~Roy.~Met.~Soc.},
+        year = "1999",
+	volume = "125",
+	pages = "723--757",
+}
+@article{jones-1999,
+        author = "P.~W.~Jones",
+        title = {{First- and Second-order Conservative Remapping Schemes for Grids in Spherical Coordinates}},
+	journal ={Monthly Weather Reveiw},
+        year = "1999",
+	volume = "127",
+	pages = "2204-2210",
+}
+@Techreport{gaspari-1998,
+        author = "G.~Gaspari and S.~E.~Cohn and D.~P.~Dee and J.~Guo and A.~M.~da~Silva",
+        title = {{Construction of the PSAS Multi-level Forecast Error Covariance Models}},
+        year = "1998",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note 98-06 {\bf http://dao.gsfc.nasa.gov/subpages/office-notes.html}",
+        address = "Greenbelt, Maryland."
+}
+@techreport{dasilva-1998a,
+        author = "A.~da Silva and  M.~Tippett and J.~Guo",
+        title = {{The PSAS Users' Manual}},
+        year = "1999",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "To be published as DAO Office Note 99-XX",
+        address = "Greenbelt, Maryland"
+}
+@Techreport{guo+al-1998a,
+        author = "J.~Guo and J.~W.~Larson and G.~Gaspari and A.~da~Silva and P.~M.~Lyster",
+        title = {{Documentation of the Physical-space Statistical Analysis System (PSAS) Part  II:  The Factored-Operator Formulation of Error Covariances}},
+        year = "1998",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note 98-04 {\bf http://dao.gsfc.nasa.gov/subpages/office-notes.html}",
+        address = "Greenbelt, Maryland."
+}
+@techreport{ODS-95,
+        author = "A.~M.~da Silva and C.~Redder",
+        title = {{Documentation of the GEOS/DAS Observation Data Stream (ODS), Version 1.01}},
+        year = "1995",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note 95-01",
+        address = "Greenbelt, Maryland"
+}
+@techreport{farrell-1996a,
+        author = "W.~E.~Farrell and A.~J.~Busalacchi and A.~Davis 
+        and W.~P.~Dannevik and G-R.~Hoffmann and M.~Kafatos and R.~W.~Moore 
+        and J.~Sloan and T.~Sterling",
+        title = {{Report of the Data Assimilation Office Computer Advisory 
+        Panel to the Laboratory for Atmospheres}},
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        address = "Greenbelt, Maryland"
+}
+@techreport{lam+daS-1996a,
+        author = "D.~Lamich and A.~da~Silva",
+        title = {{Architectural Design for the GEOS-2.1 Data Assimilation System Document Version 1}},
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note 96-XX",
+        address = "Greenbelt, Maryland"
+}
+@techreport{atbd-1996a,
+        author = "D.~A.~O.~Staff",
+        title = {{Algorithm Theoretical Basis Document, Version 1.01}},
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        address = "Greenbelt, Maryland {\bf http://dao.gsfc.nasa.gov/subpages/atbd.html}"
+}
+@techreport{suarez-1995a,
+        author = "M.~J.~Suarez and L.~L.~Takacs",
+        title = {{Documentation of the Aries-GEOS Dynamical Core: Version 2}},
+        year = "1995",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "NASA Techinical Memorandum 104606, Vol. 5",
+        address = "Greenbelt, Maryland"
+}
+@techreport{takacs-1994a,
+        author = "L.~L.~Takacs and A.~Molod and T.~Wang",
+        title = {{Documentation of the Goddard Earth Observing 
+        System (GEOS) General Circulation Model--Version 1}},
+        year = "1994",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "NASA Techinical Memorandum 104606, Vol. 1",
+        address = "Greenbelt, Maryland"
+}
+
+@techreport{pfaendtner-1995a,
+        author = "J.~W.~Pfaendtner and J.~S.~Bloom and D.~Lamich and 
+        and M.~Seablom and M.~Sienkiewicz and J.~Stobie and A.~da~Silva",
+        title = {{Documentation of the Goddard Earth Observing System 
+        (GEOS) Data Assimilation System -- Version 1}},
+        year = "1995",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "Tech. Memo No. 104606, Vol. 4",
+        address = "Greenbelt, Maryland."
+}
+@techreport{pfaendtner-1996a,
+        author = "J.~W.~Pfaendtner",
+        title = {{Notes on the Icosahedral Domain Decompostion in PSAS}},
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note 96-04 {\bf http://dao.gsfc.nasa.gov/subpages/office-notes.html}",
+        address = "Greenbelt, Maryland."
+}
+@Conference{seablom-1991a,
+        author = "M.~Seablom and J.~Pfaendtner and P.~E.~Piraino",
+        title = {{Quality Control techniques for the interactive GLA 
+        retrieval/assimilation system}},
+        year = "1991",
+        pages="28-29",
+        booktitle={{AMS Ninth Conference on Numerical Weather Prediction, 
+        Denver, Colorado, October 14-18, 1991}},
+}
+@Conference{daSilva-1995a,
+        author = "A.~da Silva and J.~Pfaendtner and J.~Guo and 
+        M.~Sienkiewicz and S.~Cohn",
+        title = {{Assessing the Effects of Data Selection with
+        DAO's Physical-space Statistical Analysis System}},
+        year = "1995",
+        booktitle="Proceedings of the Second International Symposium on the 
+        Assimilation of Observations in Meteorology and Oceanography, Tokyo Japan"
+}
+@techreport{zero-1996a,
+        author = "J.~Zero and R.~Lucchesi and R.~Rood",
+        title = {{Data Assimilation Office (DAO) Strategy Statement:  
+        Evolution Towards the 1998 Computing Environment}},
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "Tech. Memo No. 104606, Vol. 4",
+        address = "Greenbelt, Maryland"
+}
+@techreport{daSilva-1996a,
+        author = "A.~da Silva and J.~Guo",
+        title = {{Documentation of the Physical-space Statistical Analysis 
+        System (PSAS) Part I:  The Conjugate Gradient Solver, Version 
+        PSAS-1.00}}, 
+        year = "1996",
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note No.~96-02 {\bf http://dao.gsfc.nasa.gov/subpages/office-notes.html}",
+        address = "Greenbelt, Maryland"
+}
+@techreport{stobie-1996a,
+        author = "J.~Stobie",
+        title = {{GEOS 3.0 System Requirements}},
+        institution = "NASA/Goddard Space Flight Center",
+        address = "Greenbelt, Maryland"
+}
+@Conference{ding-1995a,
+        author = "C.~Ding and R.~D.~Ferraro",
+        title = {{An 18 GFLOPS Parallel Data Assimilation PSAS Package}},
+        year = "1995",
+        pages="70",
+        booktitle={{Proceedings of the Intel Supercomputer Users Group
+        Conference}}
+}
+@Conference{ding-1995b,
+        author = "C.~Ding and R.~D.~Ferraro",
+        title = {{A General Purpose Parallel Sparse-Matrix Solver Package}},
+        year = "1995",
+        pages="70",
+        booktitle={{Proceedings of the 9th International Parallel Processing Symposium}}
+}
+@Conference{ding-1996a,
+        author = "C.~Ding and R.~D.~Ferraro",
+        title = {{Climate Data Assimilation on a Massively Parallel Computer}},
+        year = "1996",
+        booktitle={{Proceedings of Supercomputing, 96}}
+}
+@techreport{hennecke-1996a,
+        author = "M.~Hennecke",
+        title = {{A Fortran 90 Interface to MPI Version 1.1}},
+        institution = "RZ Universitat Karlsruhe",
+        year = "1996",
+        number = "Internal Report 63/96",
+        address = "Karlsruhe, Germany"
+}
+@techreport{daSilva-1996b,
+        author = "A.~da Silva and C.~Redder",
+        title = {{Documentation of the GEOS/DAS Observation Data 
+        Stream (ODS) Version 1.01}},
+        institution = "NASA/Goddard Space Flight Center",
+        number = "DAO Office Note No. 96-01",
+        address = "Greenbelt, Maryland"
+}
+@book{gol+vloan-1989,
+        author = "G.~H.~Golub and C.~F.~van Loan",
+        title = {Matrix Computations},
+        edition = "second",
+        publisher = "The John Hopkins University Press",
+        year = "1989",
+        pages = "642",
+        address = "Baltimore"
+}
+@book{NumRec-1992,
+        author = " W.~H.~Press and S.~A.~Teukolsky and W.~T.~Vetterling",
+        title = {{Numerical Recipes in Fortran:  The Art of Scientific 
+        Computing}},
+        edition = "second",
+        publisher = "Cambridge University Press",
+        year = "1992",
+        pages = "963",
+        address = "Cambridge"
+}
+@book{daley-1991,
+        author = "R.~Daley",
+        title = {{Atmospheric Data Analysis}},
+        publisher = "Cambridge Press",
+        year = "1991",
+        pages = "457",
+        address = "Cambridge"
+}
+@phdthesis{vonlasz-1996a,
+        author = "G.~ von Laszewski",
+        title = {{The Parallel Data Assimilation System and its Implications on a Metacomputing Environment}},
+        school = "Syracuse University",
+        year = "1996",
+        address = "Syracuse, New York"
+}
+@proposal{lyster-1995a,
+        author = "P.~M.~Lyster",
+        title = {{Four Dimensional Data Assimilation of the Atmosphere}}, 
+        program = "NASA Cooperative Agreement for High Performance Computing 
+        and Communications (HPCC) initiative",
+        agency = "National Aeronautics and Space Administration",
+        address = "Washington, D.~C.~"
+}       
+@book{arfken,
+	author = "G.~Arfken",
+        title = {{Mathematical Methods for Physicists}},
+	publisher = "Academic Press",
+	year = "1970",
+	pages = "815",
+	address = "New York"
+}
+@article{cohn-1998,
+	author="S.~E.~Cohn and A.~da~Silva and J.~Guo and M.~Sienkiewicz and D.~Lamich",
+	title={{Assessing the effects of data selection with the DAO Physical-space Statistical Analysis System}},
+	journal={Mon.~Wea.~Rev.},
+	volume="126",
+	pages="2913--2926",
+	year="1998"
+}
+@article{lyster-1998,
+	author="P.~M.~Lyster",
+	title={{The Computational Complexity of Atmospheric Data Assimilation}},
+	journal="Submitted to {Int.~J.~Appl.~Sci.~Comp.}",
+	note="Available on-line from {\bf http://dao.gsfc.nasa.gov/DAO\_people/lys/complexity}",
+	year="1998"
+}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/mct_APIs.tex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/mct_APIs.tex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/mct_APIs.tex	(revision 4775)
@@ -0,0 +1,330 @@
+%mct API Specification
+% J.W. Larson / MCS, Argonne National Laboratory
+% R.L. Jacob
+% First Version Begun 8/28/00
+%
+%
+\documentclass{article}
+\usepackage{epsfig}
+\usepackage{graphicx}
+%\usepackage{fancyheadings}
+
+% Keep these dimensions
+
+\textheight     9in \topmargin      0pt \headsep        22pt
+\headheight     0pt
+
+\textwidth      6in \oddsidemargin  0in \evensidemargin 0in
+
+\marginparpush  0pt \pagestyle{plain}
+
+\setlength{\hoffset}{0.25in}
+
+% Headings
+% --------
+\pagestyle{plain}  % AFTER redefining \textheight etc.
+
+%  \lhead[]{{\em NGC Design Document}}   % left part of header
+%  \chead[]{}                  % center part of header
+%  \rhead[]{\em {\today}}  % right part of header
+
+ % \cfoot{\roman{page}}
+  %\lfoot[]{}      % left part of footer
+ % \rfoot[]{}      % right part of footer
+ % \headrulewidth 0pt      % if you don't want a rule under the header
+ % \footrulewidth 0pt      % if you don't want a rule above the footer
+
+%......................................................................
+%.............begin document.............
+
+\begin{document}
+
+\begin{sloppypar}
+{\huge\bf
+%%%
+%%% Enter your title below (after deleting mine)
+%%%
+The Model Coupling Toolkit API Reference Manual: MCT v. 2.8
+\\ }                     %%% IMPORTANT: Keep this \\ before the }
+\end{sloppypar}
+
+%%%
+%%% Author names and affiliations go below, follow example
+%%%
+\vspace{.3in}
+\noindent J.~W.~Larson\\
+R.~L.~Jacob\\
+E.~Ong\\
+R.~Loy\\
+\vspace{.2in} {\em Mathematics and Computer Science Division,
+Argonne National Laboratory\\}
+
+\vfill
+
+%%%
+%%% These lines are standard - keep them!
+%%% Edit the ``has not been published'' as appropriated.
+{\em This paper has not been published and should  be regarded as
+an Internal Report from MCS. Permission to quote from this
+Technical Note should be  obtained from the MCS Division of
+Argonne National Laboratory.}
+
+\vspace{0.4in}
+
+
+\thispagestyle{empty}
+\newpage
+
+%.......................... END FIRST PAGE ......................
+
+\pagenumbering{roman}
+
+%......................... REVISION HISTORY ..........................
+
+\newpage
+\setcounter{page}{2}     %%%% Revision History starts at page ii
+
+\addcontentsline{toc}{part}{Revision History}
+
+\vspace*{\fill}
+
+\centerline{\huge\bf Revision History}
+
+\bigskip
+\noindent{This Technical Note was produced for the Scientific
+Discovery through Advanced Computing (SciDAC) project.}
+
+\begin{center}
+\begin{tabular}{|l|l|l|l|}\hline
+{\bf Version} & {\bf Version} & {\bf Pages Affected/}   & {\bf Aproval}\\
+{\bf Number}  & {\bf Date}    & {\bf Extent of Changes} & {\bf Authority}\\
+\hline
+\hline 
+Version 1$\beta$ & December 13, 2000      & First draft (before review) &
+\\\hline
+Version 1$\beta2$ & February 16, 2001      & Add more routines &
+\\\hline
+Version 1$\beta3$ & June 6, 2001      & Convert to pure API's doc &
+\\\hline
+Version 1$\beta4$ & Apr 24, 2002      & Update with latest source &
+\\\hline
+Version 1.0 & Nov 14, 2002      & 1.0 Version &
+\\\hline
+Version 2.0.0 & Apr 23, 2004      & 2.0.0 Version &
+\\\hline
+Version 2.0.1 & May 18, 2004      & 2.0.1 Version &
+\\\hline
+Version 2.1.0 & Feb 11, 2005      & 2.1.0 Version &
+\\\hline
+Version 2.2.0 & Dec 01, 2005      & 2.2.0 Version &
+\\\hline
+Version 2.2.1 & Apr 22, 2006      & 2.2.1 Version &
+\\\hline
+Version 2.2.2 & Sep 08, 2006      & 2.2.2 Version &
+\\\hline
+Version 2.2.3 & Oct 16, 2006      & 2.2.3 Version &
+\\\hline
+Version 2.3.0 & Jan 10, 2007      & 2.3.0 Version &
+\\\hline
+Version 2.4.0 & Aug 17, 2007      & 2.4.0 Version &
+\\\hline
+Version 2.4.1 & Nov 21, 2007      & 2.4.1 Version &
+\\\hline
+Version 2.5.0 & Jan 28, 2008      & 2.5.0 Version &
+\\\hline
+Version 2.5.1 & May 20, 2008      & 2.5.1 Version &
+\\\hline
+Version 2.6.0 & Mar 05, 2009      & 2.6.0 Version &
+\\\hline
+Version 2.7.0 & Jan 05, 2010      & 2.7.0 Version &
+\\\hline
+Version 2.7.1 & Feb 28, 2010      & 2.7.1 Version &
+\\\hline
+Version 2.7.2 & Nov 30, 2010      & 2.7.2 Version &
+\\\hline
+Version 2.7.3 & Jan 25, 2011      & 2.7.3 Version &
+\\\hline
+Version 2.7.4 & Mar 07, 2012      & 2.7.4 Version &
+\\\hline
+Version 2.8.0 & Apr 30, 2012      & 2.8.0 Version &
+\\\hline
+\end{tabular}
+\end{center}
+
+\vspace*{\fill}
+
+
+%..........................  ABSTRACT ..................................
+\newpage
+\setcounter{page}{3}     %%%% abstract starts at page iii
+\addcontentsline{toc}{part}{Preface}
+
+\vspace*{\fill}
+
+This document describes the Application Program Interfaces (APIs)
+for the Model Coupling Toolkit (MCT).
+
+For functions that take a Fortran90 {\tt real} argument, either a scalar or
+a vector, MCT provides both double and single precision versions.  Only
+the single precision version are described here denoted by SP.  The double precision versions
+are otherwise identical.
+
+\vspace*{\fill}
+\newpage
+
+\tableofcontents
+\newpage
+
+% Switch page numbering to arabic numerals
+
+\pagenumbering{arabic}
+
+\part{Basic API's and associated communication routines}
+%
+\section{MCTWorld}
+\input{texsrc/m_MCTWorld}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{The Attribute Vector}
+\input{texsrc/m_AttrVect}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_AttrVectComms}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_AttrVectReduce}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{Global Segment Map}
+\input{texsrc/m_GlobalSegMap}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_GlobalSegMapComms}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{The Router}
+\input{texsrc/m_Router}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{The General Grid}
+\input{texsrc/m_GeneralGrid}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_GeneralGridComms}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{The Navigator}
+\input{texsrc/m_Navigator}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{The Global Map}
+\input{texsrc/m_GlobalMap}
+\vspace*{\fill}
+\newpage
+%
+%
+\part{High Level API's}
+%
+\section{Sending and Receiving Attribute Vectors}
+\input{texsrc/m_Transfer}
+\vspace*{\fill}
+\newpage
+%
+\section{Rearranging Attribute Vectors}
+\input{texsrc/m_Rearranger}
+\vspace*{\fill}
+\newpage
+%
+\section{Sprase Matrix Support}
+\input{texsrc/m_SparseMatrix}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_SparseMatrixComms}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_SparseMatrixDecomp}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_SparseMatrixToMaps}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_SparseMatrixPlus}
+\vspace*{\fill}
+\newpage
+%
+%
+\section{Matrix Vector Multiplication}
+\input{texsrc/m_MatAttrVectMul}
+\vspace*{\fill}
+\newpage
+%
+\section{Spatial Integration and Averaging}
+\input{texsrc/m_SpatialIntegral}
+\vspace*{\fill}
+\newpage
+\input{texsrc/m_SpatialIntegralV}
+\vspace*{\fill}
+\newpage
+%
+\section{Merging of Flux and State Data from Multiple Sources}
+\input{texsrc/m_Merge}
+\vspace*{\fill}
+\newpage
+%
+\section{Time Averaging}
+\input{texsrc/m_Accumulator}
+\vspace*{\fill}
+\newpage
+%
+\input{texsrc/m_AccumulatorComms}
+\vspace*{\fill}
+\newpage
+%
+\section{Global To Local Index Translation}
+\input{texsrc/m_GlobalToLocal}
+\vspace*{\fill}
+\newpage
+%
+\section{Convert From Global Map To Global Segment Map}
+\input{texsrc/m_ConvertMaps}
+\vspace*{\fill}
+\newpage
+
+\part{Documentation of MPEU Datatypes Used to Define MCT Datatypes}
+%
+\section{The String Datatype} 
+\input{texsrc/m_String}
+\vspace*{\fill}
+\newpage
+%
+\section{The List Datatype}
+\input{texsrc/m_List}
+\vspace*{\fill}
+\newpage
+
+%\addcontentsline{toc}{part}{References}
+
+%\bibliographystyle{apalike}   % for BibTeX - uses [Name, year] method??
+ 
+%\bibliography{coupler}
+\end{document}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+*.F90 *.tex
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/Makefile	(revision 4775)
@@ -0,0 +1,29 @@
+#!/bin/make
+
+TEXFILES	=
+include SRCS_tex.mk
+
+PROTEXLOC	= ../../protex/protex
+
+PROTEX          = perl $(PROTEXLOC) -b # bare mode--no TOC
+
+#-----------------------------------------------------------------------
+# Documentation
+all:
+	cp ../../mct/*.F90 .
+	cp ../../mpeu/m_String.F90 .
+	cp ../../mpeu/m_List.F90 .
+	make doc
+
+doc: $(TEXFILES)
+
+clean:
+	rm -f *.F90
+	rm -f *.tex
+
+.SUFFIXES: .F90 .tex
+
+.F90.tex:
+	$(PROTEX) $*.F90 > $*.tex
+
+#.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/SRCS_tex.mk
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/SRCS_tex.mk	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/doc/texsrc/SRCS_tex.mk	(revision 4775)
@@ -0,0 +1,31 @@
+TEXFILES= 		\
+m_Accumulator.tex       \
+m_AccumulatorComms.tex  \
+m_AttrVect.tex          \
+m_AttrVectComms.tex     \
+m_AttrVectReduce.tex    \
+m_ConvertMaps.tex       \
+m_ExchangeMaps.tex	\
+m_GeneralGrid.tex	\
+m_GeneralGridComms.tex	\
+m_GlobalMap.tex         \
+m_GlobalSegMap.tex      \
+m_GlobalSegMapComms.tex \
+m_GlobalToLocal.tex	\
+m_MCTWorld.tex		\
+m_MatAttrVectMul.tex    \
+m_Merge.tex		\
+m_Navigator.tex         \
+m_Rearranger.tex	\
+m_Router.tex		\
+m_SparseMatrix.tex      \
+m_SparseMatrixComms.tex \
+m_SparseMatrixDecomp.tex \
+m_SparseMatrixToMaps.tex \
+m_SparseMatrixPlus.tex \
+m_SpatialIntegral.tex \
+m_SpatialIntegralV.tex \
+m_String.tex \
+m_Transfer.tex \
+m_List.tex
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/Makefile	(revision 4775)
@@ -0,0 +1,20 @@
+
+SHELL = /bin/sh
+
+SUBDIRS = simple climate_concur1 climate_sequen1
+
+# TARGETS
+subdirs:
+	@for dir in $(SUBDIRS); do \
+	  cd $$dir;                \
+	  $(MAKE);                 \
+	  cd ..;                   \
+	done
+
+clean:
+	@for dir in $(SUBDIRS); do \
+	  cd $$dir;                \
+	  $(MAKE) clean;           \
+	  cd ..;                   \
+	done
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/README	(revision 4775)
@@ -0,0 +1,22 @@
+
+Directories containing example programs showing 
+the use of MCT.
+
+simple/ - Multiple single-source file examples showing how to set 
+          up MCTWorld, GSMaps and send/recv data in various two-component
+          coupled configurations (sequential and concurrent).  Require
+	  no input data.
+
+climate_concur1/ - A small program demonstrating MCT features
+  in a configuration which mimics part of a concurrently executing
+  climate model.  Uses real climate model numerical grids. Requires
+  the MCT/data directory.
+
+
+climate_sequen1/ - A small program demonstrating MCT features
+  in a configuration which mimics part of a sequentially executing
+  climate model.  Uses real climate model numerical grids.  Requires
+  the MCT/data directory
+
+
+More examples will be available in future releases.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+climate *.mod poe.*
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/Makefile	(revision 4775)
@@ -0,0 +1,52 @@
+
+SHELL           = /bin/sh
+
+# SOURCE FILES
+
+SRCS_F90	= master.F90 coupler.F90 model.F90
+
+OBJS_ALL	= $(SRCS_F90:.F90=.o)
+
+# MACHINE AND COMPILER FLAGS
+
+include ../../Makefile.conf
+
+# ADDITIONAL FLAGS SPECIFIC FOR UTMCT COMPILATION
+
+MCTLIBS    = -L$(MPEUPATH) -L$(MCTPATH) -lmct -lmpeu 
+UTLDFLAGS  = $(REAL8)
+UTCMPFLAGS = $(REAL8) $(INCFLAG)$(MPEUPATH) $(INCFLAG)$(MCTPATH)
+
+# TARGETS
+
+all: climate
+
+climate: $(OBJS_ALL) 
+	$(FC) -o $@ $(OBJS_ALL) $(FCFLAGS) $(UTLDFLAGS) $(MCTLIBS) $(MPILIBS)
+
+# RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .o
+
+.F90.o:
+	$(FC) -c $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MCTFLAGS) $(UTCMPFLAGS) $<
+
+
+clean:
+	${RM} *.o *.mod climate
+
+# DEPENDENCIES:
+
+$(OBJS_ALL): $(MCTPATH)/libmct.a
+
+
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/README	(revision 4775)
@@ -0,0 +1,38 @@
+
+This program demonstrates the use of MCT in a simple
+coupled system consisting of a "model" and a "coupler".
+
+The grids used are taken from a real climate model.
+"model" uses an atmosphere grid and "coupler" interpolates
+data on it to an ocean grid.
+
+The model and coupler run on separate pools of processors.
+
+master.F90  - the top level program
+model.F90   - the first component, an atmosphere model.
+               sends data to the coupler. 
+coupler.F90 - the second component, a coupler which takes
+                 the received atmosphere data and maps it to
+                 the ocean grid.
+
+-----------------------------------------------------
+To compile: 
+First make sure you have compiled MCT. See instructions in
+MCT/README
+
+Type "make" here or "make examples" in the top-level directory.
+
+The executable is called "climate"
+
+-----------------------------------------------------
+To run:
+"climate" requires a data file of interpolation weights in
+the directory MCT/data.  If this directory was not present when
+you untarred MCT, you can get it from the MCT website.
+
+climate requires at least 2 MPI processes to run but can run on
+any even number of processors.  Consult your
+local documentation for how to run parallel programs.
+Typical command:  mpirun -np 8 climate
+
+This program will not work with mpi-serial.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/coupler.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/coupler.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/coupler.F90	(revision 4775)
@@ -0,0 +1,315 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS coupler.F90,v 1.8 2004-04-23 20:57:10 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE: coupler -- coupler for unit tester
+!
+! !DESCRIPTION:
+! A coupler subroutine to test functionality of MCT.
+!
+! !INTERFACE:
+!
+      subroutine coupler (comm,ncomps,compid)
+!
+! !USES:
+!
+! Get the things needed from MCT by "Use,only" with renaming:
+!
+! ---------- first group is identical to what model.F90 uses ----
+!
+!---Component Model Registry
+      use m_MCTWorld,only: MCTWorld_init => init
+      use m_MCTWorld,only: MCTWorld_clean => clean
+!---Domain Decomposition Descriptor DataType and associated methods
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: GlobalSegMap_init => init
+      use m_GlobalSegMap,only: GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap,only: GlobalSegMap_clean => clean
+      use m_GlobalSegMap,only: GlobalSegMap_Ordpnts => OrderedPoints
+!---Field Storage DataType and associated methods
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : AttrVect_init => init
+      use m_AttrVect,only    : AttrVect_clean => clean
+      use m_AttrVect,only    : AttrVect_importRAttr => importRAttr
+!---Intercomponent communications scheduler
+      use m_Router,only: Router
+      use m_Router,only: Router_init => init
+      use m_Router,only: Router_clean => clean
+!---Intercomponent transfer
+      use m_Transfer,only : MCT_Send => send
+      use m_Transfer,only : MCT_Recv => recv
+
+! ---------- because coupler will do the interpolation  ---------
+!                it needs more methods
+!
+!---Sparse Matrix DataType and associated methods
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_init => init
+      use m_SparseMatrix, only : SparseMatrix_importGRowInd => &
+                                                      importGlobalRowIndices
+      use m_SparseMatrix, only : SparseMatrix_importGColInd => &
+                                                      importGlobalColumnIndices
+      use m_SparseMatrix, only : SparseMatrix_importMatrixElts => &
+                                                           importMatrixElements
+      use m_SparseMatrixPlus, only : SparseMatrixPlus
+      use m_SparseMatrixPlus, only : SparseMatrixPlus_init => init
+      use m_SparseMatrixPlus, only : SparseMatrixPlus_clean => clean
+      use m_SparseMatrixPlus, only : Xonly ! Decompose matrix by row
+!---Matrix-Vector multiply methods
+      use m_MatAttrVectMul, only: MCT_MatVecMul => sMatAvMult
+
+!---MPEU I/O utilities
+      use m_stdio
+      use m_ioutil
+
+      implicit none
+
+      include "mpif.h"
+
+! !INPUT PARAMETERS:
+
+      integer,intent(in) :: comm 
+      integer,intent(in) :: ncomps
+      integer,intent(in) :: compid
+!
+!EOP ___________________________________________________________________
+
+!     Local variables
+
+      character(len=*), parameter :: cplname='coupler.F90'
+
+      integer :: nxa   !  number of points in x-direction, atmos
+      integer :: nya   !  number of points in y-direction, atmos
+      integer :: nxo  !  number of points in x-direction, ocean
+      integer :: nyo   !  number of points in y-direction, ocean
+
+      character(len=100),parameter :: &
+        RemapMatrixFile='../../data/t42_to_popx1_c_mat.asc'
+
+! Loop indicies
+      integer :: i,j,k,n
+
+      logical :: match
+
+! MPI variables
+      integer :: rank, nprocs, root, ierr
+! MCTWorld variables
+      integer :: AtmID
+! Grid variables
+      integer :: localsize 
+! GlobalSegMap variables
+      type(GlobalSegMap)   :: AtmGSMap, OcnGSMap       
+      integer,dimension(1) :: start,length  
+      integer, dimension(:), pointer :: points
+      integer :: latsize, lonsize
+      integer :: rowindex, colindex, boxvertex
+! AttVect variables
+      type(AttrVect) :: AtmAV, OcnAV           
+      integer :: aavsize,oavsize
+! Router variables
+      type(Router) :: Rout
+! SparseMatrix variables
+      integer :: mdev
+      integer :: num_elements, nRows, nColumns
+      integer, dimension(2) :: src_dims, dst_dims
+      integer, dimension(:), pointer :: rows, columns
+      real, dimension(:), pointer :: weights
+! A2O SparseMatrix elements on root
+      type(SparseMatrix) :: sMat
+! A2O distributed SparseMatrixPlus variables
+      type(SparseMatrixPlus) :: A2OMatPlus
+! _____________________________________________________________________
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   INITIALIZATION PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      
+      ! LOCAL RANK AND SIZE
+      call MPI_COMM_RANK(comm,rank,ierr)
+      call MPI_COMM_SIZE(comm,nprocs,ierr)
+      root = 0
+
+      if(rank==0) write(6,*) cplname,' MyID ', compid
+      if(rank==0) write(6,*) cplname,' Num procs ', nprocs
+
+      ! Initialize MCTworld
+      call MCTWorld_init(ncomps,MPI_COMM_WORLD,comm,compid)
+
+      ! Set the atm component id.  Must be known to this
+      !  component.  (MCT doesn't handle that).
+      AtmID=1
+
+      ! Set grid dimensions for atmosphere and ocean grids.
+      ! MCT could be used for this (by defining a GeneralGrid in
+      ! each and sending them to the coupler) but for this simple
+      ! example, we'll assume they're known to the coupler
+      nxa = 128
+      nya = 64
+  
+      nxo = 320
+      nyo = 384
+      
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Read matrix weights for interpolation from a file.
+      if (rank == root) then
+         mdev = luavail()
+         open(mdev, file=trim(RemapMatrixFile), status="old")
+         read(mdev,*) num_elements
+         read(mdev,*) src_dims(1), src_dims(2)
+         read(mdev,*) dst_dims(1), dst_dims(2)
+         
+         allocate(rows(num_elements), columns(num_elements), &
+              weights(num_elements), stat=ierr)
+
+         do n=1, num_elements
+            read(mdev,*) rows(n), columns(n), weights(n)
+         end do
+         
+         close(mdev)
+
+         ! Initialize a Sparsematrix
+         nRows = dst_dims(1) * dst_dims(2)
+         nColumns = src_dims(1) * src_dims(2)     
+         call SparseMatrix_init(sMat,nRows,nColumns,num_elements)
+         call SparseMatrix_importGRowInd(sMat, rows, size(rows))
+         call SparseMatrix_importGColInd(sMat, columns, size(columns))
+         call SparseMatrix_importMatrixElts(sMat, weights, size(weights))
+
+         deallocate(rows, columns, weights, stat=ierr)
+
+      endif
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize a Global Segment Map for the Ocean
+
+      ! Set up a 1-d decomposition.
+      ! There is just 1 segment per processor
+      localsize = nxo*nyo / nprocs
+
+      ! we'll use the distributed init of GSMap so
+      ! initialize start and length arrays for this processor
+      start(1) = (rank*localsize) + 1
+      length(1) = localsize
+
+      ! initialize the GSMap
+      call GlobalSegMap_init(OcnGSMap,start,length,root,comm,compid)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize a Global Segment Map for the Atmosphere
+
+      ! Set up a 1-d decomposition.
+      ! There is just 1 segment per processor
+      localsize = nxa*nya / nprocs
+
+      ! we'll use the distributed init of GSMap so
+      ! initialize start and length arrays for this processor
+      start(1) = (rank*localsize) + 1
+      length(1) = localsize
+
+      ! initialize the GSMap
+      call GlobalSegMap_init(AtmGSMap,start,length,root,comm,compid)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      ! Use a GSMap function:
+      ! return the points local to this processor
+      ! in their assumed order.
+      call GlobalSegMap_Ordpnts(AtmGSMap,rank,points)
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Build a SparseMatrixPlus for doing the interpolation
+      ! Specify matrix decomposition to be by row.
+      ! following the atmosphere's decomposition.
+      call SparseMatrixPlus_init(A2OMatPlus, sMat, AtmGSMap, OcnGSMap, &
+           Xonly, root, comm, compid)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize and Attribute vector the atmosphere grid
+      aavsize = GlobalSegMap_lsize(AtmGSMap,comm)
+      if(rank==0) write(6,*) cplname, ' localsize: Atm ', aavsize
+      call AttrVect_init(AtmAV,rList="field1:field2",lsize=aavsize)
+
+
+      ! Initialize and Attribute vector the ocean grid
+      oavsize = GlobalSegMap_lsize(OcnGSMap,comm)
+      if(rank==0) write(6,*) cplname, ' localsize: Ocn ', oavsize
+      call AttrVect_init(OcnAV,rList="field1:field2",lsize=oavsize)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize a Router
+      call Router_init(AtmID,AtmGSMap,comm,Rout)
+
+!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   RUN PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      do j=1,10   ! "timestep" loop
+
+
+        ! coupler calculations here
+
+        match=.TRUE.
+
+        ! Receive the data
+        call MCT_Recv(AtmAV,Rout)
+
+        ! The 2nd attribute has the values of each gridpoint in
+        ! the index numbering scheme.  Check the received values
+        ! against the points on the this processor.  They should
+        ! match exactly.
+        do i=1,aavsize
+           if( int(AtmAV%rAttr(2,i)) .ne. points(i)) then
+             write(6,*) cplname,rank, " Data doesn't match ",i
+             match=.FALSE.
+           endif
+        enddo
+        if(match .and. j==10) &
+         write(6,*) cplname," Last step, All points match on ",rank
+
+        if(rank==0) write(6,*) cplname, " Received data step ",j
+
+        ! Interpolate by doing a parallel sparsematrix-attrvect multiply
+        ! Note:  it doesn't make much sense to interpolate "field2" which
+        ! is the grid point indicies but MatVecMul will interpolate all
+        ! real attributes.
+        call MCT_MatVecMul(AtmAV, A2OMatPlus, OcnAV)
+        if(rank==0) write(6,*) cplname," Data transformed step ",j
+
+
+        ! pass interpolated data on to ocean model and/or
+        !  do more calculations
+
+      enddo
+
+
+!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   FINALIZE PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      ! deallocate memory
+      call Router_clean(Rout)
+      call AttrVect_clean(AtmAV)
+      call AttrVect_clean(OcnAV)
+      call GlobalSegMap_clean(AtmGSMap)
+      call GlobalSegMap_clean(OcnGSMap)
+      call MCTWorld_clean()
+      if(rank==0) write(6,*) cplname, " done"
+
+    end subroutine coupler
+         
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/master.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/master.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/master.F90	(revision 4775)
@@ -0,0 +1,89 @@
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS master.F90,v 1.7 2004-04-23 05:43:11 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE: master  -- driver for simple concurrent coupled model
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect to 
+!  components executing concurrently in a single executable. 
+!
+! !INTERFACE:
+!
+      program master
+!
+! !USES:
+!
+
+      implicit none
+
+      include "mpif.h"
+
+!
+!EOP ___________________________________________________________________
+
+!     local variables
+
+      character(len=*), parameter :: mastername='master.F90'
+
+      integer, parameter :: ncomps = 2   ! Must know total number of 
+                                         ! components in coupled system
+
+      integer, parameter :: AtmID = 1    ! pick an id for the atmosphere
+      integer, parameter :: CplID = 2    ! pick an id for the coupler
+
+
+
+
+! MPI variables
+      integer :: splitcomm, rank, nprocs,compid, myID, ierr,color
+      integer :: anprocs,cnprocs
+
+!-----------------------------------------------------------------------
+! The Main program. 
+! We are implementing a single-executable, concurrent-execution system.
+!
+! This small main program carves up MPI_COMM_WORLD and then starts
+! each component on its own processor set.
+
+      ! Initialize MPI
+      call MPI_INIT(ierr)
+
+      ! Get basic MPI information
+      call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ierr)
+      call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
+
+      ! Create MPI communicators for each component
+      !
+      ! each component will run on half the processors
+      !
+      ! set color
+      if (rank .lt. nprocs/2) then
+        color = 0
+      else
+        color = 1
+      endif
+
+
+      ! Split MPI_COMM_WORLD into communicators for each component.
+      call MPI_COMM_SPLIT(MPI_COMM_WORLD,color,0,splitcomm,ierr)
+
+
+      ! Start the components
+      select case (color)
+         case(0)
+            call model(splitcomm,ncomps,AtmID)
+         case(1)
+            call coupler(splitcomm,ncomps,CplID)
+         case default
+            print *, "color error, color = ", color
+      end select
+
+      ! Components are done
+      call MPI_FINALIZE(ierr)
+
+
+    end program master
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/model.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/model.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_concur1/model.F90	(revision 4775)
@@ -0,0 +1,198 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS model.F90,v 1.8 2004-04-23 20:56:23 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE: model -- generic model for unit tester
+!
+! !DESCRIPTION:
+! A generic model subroutine to test functionality of MCT.
+!
+! !INTERFACE:
+!
+      subroutine model (comm,ncomps,compid)
+!
+! !USES:
+!
+! Get the things needed from MCT by "Use,only" with renaming:
+!
+!---Component Model Registry
+      use m_MCTWorld,only: MCTWorld_init => init
+      use m_MCTWorld,only: MCTWorld_clean => clean
+!---Domain Decomposition Descriptor DataType and associated methods
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: GlobalSegMap_init => init
+      use m_GlobalSegMap,only: GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap,only: GlobalSegMap_clean => clean
+      use m_GlobalSegMap,only: GlobalSegMap_Ordpnts => OrderedPoints
+!---Field Storage DataType and associated methods
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : AttrVect_init => init
+      use m_AttrVect,only    : AttrVect_clean => clean
+      use m_AttrVect,only    : AttrVect_indxR => indexRA
+      use m_AttrVect,only    : AttrVect_importRAttr => importRAttr
+!---Intercomponent communications scheduler
+      use m_Router,only: Router
+      use m_Router,only: Router_init => init
+      use m_Router,only: Router_clean => clean
+!---Intercomponent transfer
+      use m_Transfer,only : MCT_Send => send
+      use m_Transfer,only : MCT_Recv => recv
+!---Stored Grid data
+
+      implicit none
+      
+      include "mpif.h"
+
+! !INPUT PARAMETERS:
+
+      integer,intent(in) :: comm    ! MPI communicator for this component
+      integer,intent(in) :: ncomps  ! total number of models in coupled system
+      integer,intent(in) :: compid  ! the integer id of this model
+!
+!EOP ___________________________________________________________________
+
+!     local variables
+
+!     parameters for this model
+      character(len=*), parameter :: modelname='model.F90'
+      integer,parameter :: nxa = 128  ! number of points in x-direction
+      integer,parameter :: nya = 64   ! number of points in y-direction
+
+      integer :: i,j,k
+
+!     note decleration of instances of MCT defined types.
+! MPI variables
+      integer :: rank, nprocs, root, CplID, ierr
+! Grid variables
+      integer :: localsize 
+! GlobalSegMap variables
+      type(GlobalSegMap)   :: GSMap             ! MCT defined type
+      integer,dimension(1) :: start,length  
+      integer, dimension(:), pointer :: points
+! AttrVect variables
+      type(AttrVect) :: AV                      ! MCT defined type
+      real, dimension(:), pointer :: avdata
+      integer :: avsize
+! Router variables
+      type(Router) :: Rout                      ! MCT defined type
+! _____________________________________________________________________
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   INITIALIZATION PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      ! Get local rank and size
+      call MPI_COMM_RANK (comm,rank, ierr)
+      call MPI_COMM_SIZE(comm,nprocs,ierr)
+      root = 0
+
+      if(rank==0) write(6,*) modelname,' MyID ', compid
+      if(rank==0) write(6,*) modelname,' Num procs ', nprocs
+
+      ! Initialize MCTworld
+      call MCTWorld_init(ncomps,MPI_COMM_WORLD,comm,compid)
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize a Global Segment Map
+
+      ! set up a 1-d decomposition.
+      ! there is just 1 segment per processor
+      localsize = nxa*nya / nprocs
+
+      ! we'll use the distributed init of GSMap so
+      ! initialize start and length arrays for this processor
+      start(1) = (rank*localsize) + 1
+      length(1) = localsize
+
+      ! initialize the GSMap
+      call GlobalSegMap_init(GSMap,start,length,root,comm,compid)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      ! Use a GSMap function:
+      ! return the points local to this processor 
+      ! in their assumed order.
+      call GlobalSegMap_Ordpnts(GSMap,rank,points)
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize an Attribute vector
+      
+      ! size is the number of grid point on this processor
+      avsize = GlobalSegMap_lsize(GSMap,comm)
+      if(rank==0) write(6,*) modelname, ' localsize ', avsize
+
+      ! initialize Av with two real attributes.
+      call AttrVect_init(AV,rList="field1:field2",lsize=avsize)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! Initialize a router to the coupler component.
+      !
+      ! Need to know the integer ID of the coupler.
+      CplID = 2
+      call Router_init(CplID,GSMap,comm,Rout)
+
+      !  create an array used in RUN
+      allocate(avdata(avsize),stat=ierr)
+!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   RUN PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     
+
+      do j=1,10    ! "timestep" loop 
+
+
+        ! model calculations
+
+
+        ! load data into aV
+        ! load the first field using "import" method.
+        ! First field will be a constant real number.
+        avdata=30.0
+        call AttrVect_importRAttr(AV,"field1",avdata)
+
+        ! Load the second field using direct access
+        ! Second field will be the indicies of each grid point
+        ! in the grid point numbering scheme.
+        do i=1,avsize
+           AV%rAttr(AttrVect_indxR(AV,"field2"),i) = points(i)
+        enddo
+
+        ! Send the data
+        !  this is a synchronization point between the coupler and
+        !   this model.  
+        if(rank==0) write(6,*) modelname,' sending data step ',j
+        call MCT_Send(AV,Rout)
+
+
+        ! more model calculations
+
+ 
+      enddo
+
+!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   FINALIZE PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! clean up
+      call Router_clean(Rout)
+      call AttrVect_clean(AV)
+      call GlobalSegMap_clean(GSMap)
+      call MCTWorld_clean()
+      if(rank==0) write(6,*) modelname,' done'
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    end subroutine model
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+MCT.* *.mod climate
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/Makefile	(revision 4775)
@@ -0,0 +1,51 @@
+
+SHELL           = /bin/sh
+
+# SOURCE FILES
+
+SRCS_F90	= mutils.F90 srcmodel.F90 dstmodel.F90 coupler.F90 master.F90
+
+OBJS_ALL	= $(SRCS_F90:.F90=.o)
+
+# MACHINE AND COMPILER FLAGS
+
+include ../../Makefile.conf
+
+# ADDITIONAL FLAGS SPECIFIC FOR UTMCT COMPILATION
+
+MCTLIBS    = -L$(MPEUPATH) -L$(MCTPATH) -lmct -lmpeu 
+UTLDFLAGS  = $(REAL8)
+UTCMPFLAGS = $(REAL8) $(INCFLAG)$(MPEUPATH) $(INCFLAG)$(MCTPATH)
+
+# TARGETS
+
+all: climate
+
+climate: $(OBJS_ALL) 
+	$(FC) -o $@ $(OBJS_ALL) $(FCFLAGS) $(UTLDFLAGS) $(MCTLIBS) $(MPILIBS)
+
+# RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .o
+
+.F90.o:
+	$(FC) -c $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MCTFLAGS) $(UTCMPFLAGS) $<
+
+clean:
+	${RM} *.o *.mod climate
+
+# DEPENDENCIES:
+
+$(OBJS_ALL): $(MCTPATH)/libmct.a
+
+
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/README	(revision 4775)
@@ -0,0 +1,42 @@
+
+This program demonstrates the use of MCT in a simple
+coupled system consisting of two models and a coupler.
+
+The grids used are taken from a real climate model.
+"srcmodel" uses an atmosphere grid and "coupler" interpolates
+data on it to an ocean grid in "dstmodel"
+
+The srcmodel reads in a temperature field TS1.dat on the the atmosphere grid.
+dstmodel outputs the interpolated temperature field to TS1out.dat
+
+srcmodel,dstmodel and coupler  are broken into init, run and finalize phases.
+
+The model and coupler run sequentially on a pool of processors
+
+master.F90  - the top level program
+srcmodel.F90   - the first component, an atmosphere model.
+dstmodel.F90   - the second component, an ocean model.
+coupler.F90 - the third component, a coupler which takes
+                 the atmosphere data and maps it to
+                 the ocean grid.
+
+-----------------------------------------------------
+To compile: 
+First make sure you have compiled MCT. See instructions in
+MCT/README
+
+Type "make" here or "make examples" in the top-level directory.
+
+The executable is called "climate"
+
+-----------------------------------------------------
+To run:
+"climate" requires a data file of interpolation weights in
+the directory MCT/data.  If this directory was not present when
+you untarred MCT, you can get it from the MCT website.
+
+climate requires at least 1 MPI processes to run but can run on
+any even number of processors.  Consult your
+local documentation for how to run parallel programs.
+
+Typical command:  mpirun -np 8 climate
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/TS1.dat
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/TS1.dat	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/TS1.dat	(revision 4775)
@@ -0,0 +1,8193 @@
+128 64
+210.598221
+210.370956
+210.200317
+209.999313
+209.773987
+209.545242
+209.338638
+209.079834
+208.818771
+208.530273
+208.189346
+207.917847
+207.668228
+207.482681
+207.322525
+207.134918
+206.982986
+206.822006
+206.676392
+206.721191
+206.731567
+206.764267
+206.714890
+206.735657
+206.747650
+206.827255
+206.850861
+206.983688
+207.129868
+207.300278
+207.427399
+207.649628
+207.937622
+208.207809
+208.546432
+208.819489
+209.170090
+209.519623
+209.858063
+210.218704
+210.569855
+210.952911
+211.282089
+211.552551
+211.894699
+212.337753
+212.782440
+213.256454
+213.748413
+214.255295
+214.766602
+215.275497
+215.744263
+216.132645
+216.580765
+217.098587
+217.593170
+218.020859
+218.403473
+218.774872
+219.153122
+219.486679
+219.813370
+220.131027
+220.357315
+220.542770
+220.604584
+220.937531
+221.070450
+221.289825
+221.557281
+221.853806
+222.160858
+222.459793
+222.693054
+222.786880
+222.874527
+222.896362
+222.825470
+222.752060
+222.734604
+222.658218
+222.471939
+222.252823
+222.029297
+221.792542
+221.557983
+221.311111
+220.990540
+220.650986
+220.355820
+219.980530
+219.635452
+219.326462
+218.962769
+218.577789
+218.222351
+217.879379
+217.496918
+217.081879
+216.670471
+216.243790
+215.800110
+215.363174
+214.910431
+214.569214
+214.127563
+213.685287
+213.289276
+212.880142
+213.003998
+213.130981
+213.308594
+213.289597
+212.976425
+212.866028
+212.840363
+212.713272
+212.476395
+212.316055
+212.394791
+212.154297
+211.890137
+211.663696
+211.405029
+211.171967
+211.026276
+210.856613
+213.167435
+212.562256
+212.014374
+211.504456
+211.025330
+210.481094
+209.938019
+209.340591
+208.417923
+207.137955
+205.945206
+204.466553
+202.577072
+200.389435
+198.414307
+196.707825
+195.323639
+194.249283
+192.984116
+191.853104
+190.434647
+190.028534
+189.964020
+189.970642
+190.117691
+190.522552
+191.164093
+191.902359
+192.807236
+193.725388
+194.719238
+195.973923
+197.250046
+199.003326
+200.910721
+202.147079
+203.195541
+203.966690
+205.127243
+206.276566
+206.781235
+207.342941
+207.898224
+208.407654
+209.211517
+210.186508
+211.245926
+212.426620
+213.630768
+214.591736
+215.851624
+217.332382
+218.879410
+220.246094
+221.651947
+223.145447
+224.005936
+224.752151
+225.357178
+226.345139
+227.101364
+228.065659
+228.966431
+229.100510
+230.123230
+230.977768
+231.241364
+231.654526
+231.855270
+235.246109
+235.445724
+235.503387
+235.447708
+235.248032
+233.090515
+232.651276
+232.059616
+231.876999
+231.778717
+231.750641
+231.459259
+230.894257
+230.159058
+229.533539
+229.958359
+229.331268
+228.658630
+227.984222
+227.349060
+226.695679
+225.077408
+223.466232
+221.725479
+221.504913
+221.443954
+221.182358
+220.250595
+220.077789
+220.920624
+222.083618
+222.760086
+222.779373
+222.677231
+222.581085
+222.494858
+222.415268
+222.327332
+222.277954
+222.224213
+222.164093
+222.143753
+222.175461
+222.210510
+222.056595
+221.827530
+221.473419
+221.094986
+220.646164
+220.121704
+219.539032
+218.877380
+218.169312
+217.399780
+216.614441
+215.835999
+215.063995
+214.336258
+213.638046
+215.556839
+214.143646
+212.680069
+211.400772
+210.178741
+208.861877
+207.274490
+205.058029
+202.457718
+199.698135
+197.382919
+195.492950
+194.106613
+192.725250
+191.600372
+190.947159
+190.290909
+189.465027
+186.893555
+185.100830
+184.374512
+184.130112
+183.782822
+183.367874
+183.250015
+183.133804
+183.022476
+183.095383
+183.638931
+184.575165
+185.803024
+187.062988
+188.894089
+190.552078
+192.286118
+193.417603
+195.194046
+197.707962
+200.826935
+203.688507
+205.255905
+205.875717
+206.337860
+206.663528
+207.365692
+207.999008
+208.404755
+209.958054
+211.473389
+213.113861
+214.949188
+217.032959
+219.286453
+221.279465
+223.460953
+225.035309
+226.788651
+227.175400
+228.037872
+235.137680
+236.596985
+237.839508
+238.908478
+239.669586
+240.169785
+240.624069
+240.848145
+240.866089
+240.343811
+240.016068
+239.366928
+238.294479
+237.757645
+237.197769
+226.152878
+225.532440
+224.927856
+225.174408
+225.600693
+226.000214
+226.331573
+226.283493
+226.036835
+225.600281
+224.700211
+223.377274
+222.089157
+220.716812
+220.822800
+219.998932
+218.664337
+217.075836
+216.318375
+216.012772
+216.365967
+216.833740
+217.248184
+218.718140
+220.790848
+224.842697
+227.980240
+228.560654
+228.919907
+229.107925
+229.643784
+230.317825
+230.689423
+231.045853
+231.218002
+231.631363
+232.147446
+232.725494
+233.351242
+233.979721
+234.391464
+233.847321
+233.173294
+232.267868
+231.373795
+229.994705
+228.617630
+226.905823
+225.032150
+223.399902
+221.907013
+220.051224
+218.387192
+216.907990
+216.803253
+214.330490
+212.666077
+211.305756
+209.714539
+208.160431
+206.624924
+204.745132
+202.388794
+200.705963
+199.604858
+198.958603
+198.529282
+198.494705
+198.366898
+198.511841
+198.526398
+198.483109
+198.481888
+196.241806
+194.316101
+195.219955
+196.749954
+198.072418
+198.284668
+197.068298
+194.908432
+191.956192
+189.250092
+186.491058
+184.236938
+183.249725
+183.637604
+184.810577
+186.584885
+189.267258
+191.118713
+192.881485
+194.483322
+196.234467
+197.321030
+198.656067
+199.488083
+200.601730
+201.736862
+202.883148
+204.424118
+205.990936
+207.530136
+209.261200
+211.170059
+213.168182
+215.410522
+217.802292
+221.807510
+225.082321
+227.731567
+230.305405
+234.507309
+236.748611
+238.697388
+240.269302
+241.385284
+241.801010
+242.278534
+242.475616
+241.820312
+240.339005
+238.250641
+235.985336
+235.027740
+235.721375
+235.590530
+236.166336
+227.330338
+227.829422
+225.608932
+225.338638
+226.067764
+226.972641
+228.235962
+229.247818
+229.865173
+229.445694
+228.165390
+226.516830
+224.984421
+223.781662
+222.570251
+220.534103
+219.150116
+218.304306
+217.669205
+217.182922
+217.995422
+219.271072
+220.411377
+222.585175
+224.228394
+225.086761
+228.922073
+232.388336
+232.858475
+233.568344
+234.537537
+235.637100
+236.969269
+238.463333
+239.950439
+233.884460
+234.261917
+235.947968
+237.480743
+246.237122
+246.724487
+246.729843
+242.308350
+241.468597
+238.629440
+233.350159
+232.267059
+230.252396
+227.592026
+224.840179
+222.396255
+223.133240
+220.707642
+219.132935
+217.075272
+212.818604
+209.693283
+207.163101
+205.337723
+203.381042
+202.002075
+200.424271
+199.532822
+200.810440
+202.920486
+204.497971
+205.334732
+205.805710
+206.097427
+206.785324
+207.351974
+207.284286
+207.248703
+206.631348
+204.505142
+204.932251
+205.157883
+205.533630
+205.957703
+205.994156
+206.462448
+206.938202
+206.845764
+205.541077
+203.267120
+199.568680
+196.129684
+193.607971
+194.003128
+195.612839
+197.663803
+198.066711
+198.175110
+198.009781
+197.872818
+197.890167
+197.997025
+197.955460
+198.879669
+200.427582
+201.480591
+202.802475
+204.993851
+207.465668
+209.653366
+212.042679
+214.537018
+217.207047
+220.008331
+222.901230
+225.834305
+228.763412
+231.508957
+235.266205
+237.701294
+239.822601
+241.556580
+242.849701
+243.441254
+243.835724
+244.082169
+243.937134
+243.518021
+242.543228
+239.571030
+237.307816
+235.659332
+235.331055
+237.555786
+237.983734
+227.302689
+226.626282
+226.627762
+226.923370
+227.548691
+228.518768
+233.553268
+233.180557
+231.671539
+229.297409
+226.110962
+224.788040
+224.307465
+224.276642
+224.250275
+224.226349
+224.249619
+224.540970
+224.784851
+224.899216
+224.615601
+224.265488
+224.227798
+225.339493
+227.531403
+228.531525
+229.157959
+230.206482
+231.741028
+236.652466
+238.289352
+240.121048
+242.116043
+244.084290
+246.014084
+247.713684
+248.578842
+248.167892
+248.566437
+248.895050
+249.638535
+249.198868
+240.670593
+238.254501
+234.596741
+231.307693
+229.274506
+228.187164
+225.986938
+227.384964
+224.577286
+221.570511
+233.674194
+231.766693
+230.290558
+228.810776
+226.972916
+224.844421
+221.683044
+219.777649
+218.624634
+218.878876
+219.472687
+220.139496
+220.303497
+219.374481
+217.834381
+216.290939
+214.593552
+212.577652
+211.100952
+211.091675
+210.422791
+208.266266
+207.504425
+209.187073
+211.201569
+209.356781
+209.906860
+212.042496
+214.548691
+220.531525
+220.352341
+215.327454
+207.993683
+205.045975
+205.060623
+205.866959
+205.786850
+205.538513
+204.943970
+204.880371
+204.659744
+204.709122
+203.280991
+202.153885
+203.263855
+204.885345
+205.702637
+206.837646
+208.926666
+211.051392
+213.485641
+215.877701
+218.358414
+220.931931
+223.410675
+225.733551
+228.032791
+230.226654
+232.499664
+234.857681
+237.059677
+240.249039
+242.322754
+243.976822
+245.226059
+246.032501
+246.406494
+246.443176
+246.180862
+245.751923
+245.185150
+243.538345
+240.405624
+239.348785
+238.994873
+239.435455
+240.171463
+240.269211
+240.193787
+239.949814
+239.742096
+239.719116
+240.075119
+240.776276
+241.193054
+234.442001
+240.280457
+239.104736
+238.409805
+237.937637
+237.865448
+237.386124
+236.494034
+232.030960
+233.395798
+233.877304
+234.296600
+234.369064
+234.960968
+235.306015
+235.436157
+235.978806
+236.175079
+236.420105
+237.009018
+237.998825
+239.358215
+242.386658
+244.207108
+246.046600
+247.820633
+249.402542
+251.017044
+252.288940
+252.520233
+252.438110
+251.875015
+250.971695
+248.615524
+246.374710
+243.145737
+240.921326
+231.697464
+230.287155
+229.651566
+231.731689
+236.549210
+235.273453
+241.647888
+241.563858
+241.577255
+241.488342
+241.050125
+240.381561
+238.435043
+236.724564
+236.911743
+237.364456
+238.172852
+238.720047
+239.087982
+239.064896
+237.673416
+235.307007
+231.666153
+226.408035
+221.938004
+219.849472
+219.547806
+217.750092
+217.415985
+219.228638
+222.837601
+226.718109
+231.130997
+236.459869
+239.557327
+239.733368
+237.241928
+232.325134
+226.267807
+221.730621
+220.718689
+222.741821
+221.684662
+220.566879
+219.095505
+217.708908
+216.635040
+216.239120
+216.149796
+216.250519
+216.348984
+216.308731
+216.181351
+216.253021
+216.634979
+217.657379
+219.376923
+221.368530
+223.879532
+226.487610
+229.064529
+231.016373
+232.477173
+233.763885
+234.739105
+235.854614
+237.255753
+240.270844
+242.283463
+244.228958
+245.873520
+246.957321
+247.533920
+247.733551
+247.620361
+247.240509
+246.763062
+246.293381
+245.924805
+245.536118
+244.966049
+244.618484
+244.249115
+244.080643
+243.951401
+243.963531
+244.089920
+244.293488
+244.600174
+244.911285
+245.035950
+244.990753
+244.516235
+243.776459
+243.028473
+242.634949
+241.989227
+241.559769
+240.780396
+240.651596
+240.678833
+240.986801
+241.551239
+242.032562
+242.347351
+242.470444
+242.354141
+242.065781
+241.810623
+240.813141
+240.803055
+241.600952
+242.604828
+244.836624
+246.318222
+247.883957
+249.172119
+250.429871
+251.156616
+251.757172
+253.076294
+253.409271
+252.756409
+250.574570
+249.624023
+247.305374
+246.143738
+244.985901
+244.100540
+242.950470
+242.065292
+238.393127
+240.074860
+242.011047
+248.560425
+248.369232
+248.228989
+248.124649
+247.922943
+247.543182
+246.991180
+246.257065
+245.402115
+244.688126
+244.208969
+244.054367
+244.114288
+243.681351
+243.043854
+239.749405
+239.431793
+237.868866
+235.753128
+233.133560
+230.818161
+229.447495
+229.773438
+232.099960
+235.966873
+242.815628
+248.433365
+251.144333
+251.804398
+248.780624
+246.646194
+244.207458
+239.708435
+238.320419
+237.095413
+236.195862
+235.080215
+234.204468
+233.162674
+232.286148
+231.844482
+231.671051
+231.545959
+231.209808
+230.402130
+229.014374
+227.202591
+225.376328
+224.090317
+223.763229
+224.561493
+226.258163
+228.323685
+232.464325
+227.765762
+235.967834
+236.834442
+237.007812
+237.224182
+237.560440
+236.882858
+238.725052
+240.611023
+242.861053
+245.012619
+246.806793
+248.132980
+248.892868
+249.370560
+249.504425
+249.000244
+248.332611
+247.642822
+246.833740
+246.374100
+246.109879
+246.124512
+246.426910
+246.857285
+247.159607
+247.252274
+247.155426
+246.818588
+246.232391
+245.663559
+245.243240
+245.042068
+244.669373
+244.152802
+243.503418
+242.897263
+242.431366
+242.032593
+241.791153
+241.841644
+242.249863
+242.987534
+243.963226
+245.015060
+246.023743
+246.797180
+247.412277
+247.853516
+248.207443
+248.381622
+247.375809
+248.929626
+249.250320
+249.813873
+250.607330
+251.437881
+251.941452
+252.757812
+253.399261
+253.757568
+253.844879
+253.831039
+252.951538
+251.238876
+249.642685
+249.233582
+248.723206
+248.573288
+248.478531
+248.782654
+248.899124
+248.792480
+248.734940
+258.557220
+258.505646
+257.810181
+256.639191
+255.411148
+254.010483
+252.732178
+251.542892
+250.241898
+248.964355
+247.691467
+246.481705
+245.583878
+245.857437
+245.969803
+246.261154
+246.706787
+246.671906
+245.939911
+244.849060
+243.761597
+243.161652
+243.664917
+245.415344
+248.177887
+252.080460
+256.314117
+258.248413
+258.366577
+257.311859
+255.547623
+252.558380
+250.714615
+250.067398
+249.588455
+249.108063
+248.532639
+247.699600
+246.767624
+245.961929
+245.740891
+246.115860
+246.831268
+247.425919
+247.374924
+246.367233
+244.456070
+242.050140
+239.797256
+238.327301
+237.909103
+238.621552
+239.992477
+241.275772
+241.817230
+241.753815
+241.639816
+241.436356
+241.920883
+242.477615
+243.142319
+244.339874
+245.988068
+247.566025
+249.295059
+251.188568
+253.076019
+254.260925
+255.326767
+256.095917
+256.057953
+255.536560
+254.447784
+252.639938
+251.036072
+250.247498
+250.327698
+250.976669
+252.456467
+253.944321
+254.573898
+254.902069
+254.253860
+253.066162
+252.260345
+251.261536
+250.158615
+249.016098
+247.917328
+247.096786
+246.412323
+245.697128
+244.972504
+244.631882
+244.938675
+245.872604
+247.344315
+249.211578
+251.333481
+253.471939
+254.680649
+255.519562
+256.252106
+257.019043
+257.411438
+256.582733
+254.931778
+254.267059
+253.746490
+253.566498
+253.864548
+254.528732
+255.179321
+255.838425
+256.246979
+256.338745
+256.289581
+255.836777
+254.964218
+253.893906
+252.838593
+252.136093
+252.008408
+252.580963
+253.771606
+255.261963
+256.737152
+257.906799
+268.072296
+268.586670
+268.314728
+267.356903
+265.898376
+263.972809
+261.564636
+259.257660
+256.889832
+254.743210
+253.002686
+251.409027
+249.706772
+248.684296
+247.991470
+248.406128
+248.770508
+249.065582
+250.180084
+250.634506
+250.590302
+250.362122
+250.363251
+250.912277
+252.114761
+253.839066
+256.294708
+258.334869
+259.414337
+259.174652
+259.972626
+259.292542
+258.190369
+257.421173
+256.768372
+256.124115
+255.614548
+255.188187
+254.860031
+255.158752
+256.130188
+257.863007
+260.090881
+262.369293
+271.407104
+271.512756
+271.641418
+271.765808
+271.796997
+271.808960
+271.768951
+271.646973
+271.497284
+271.481445
+271.474243
+271.506073
+271.515991
+271.434570
+255.415192
+271.654144
+271.763824
+272.168732
+272.224487
+272.197266
+272.163483
+272.145477
+272.128143
+272.110657
+272.098419
+272.067688
+271.997772
+271.876465
+271.465485
+271.413879
+271.349854
+258.953918
+258.900208
+260.095337
+271.470551
+271.554962
+271.883484
+272.018219
+272.294312
+272.577179
+272.774384
+272.880585
+272.948944
+273.015839
+273.076111
+273.137329
+273.200195
+273.261505
+273.305878
+273.322662
+273.321625
+273.310822
+273.270386
+273.179657
+272.995392
+272.698151
+272.339844
+272.260284
+272.112274
+271.890900
+272.402832
+271.172791
+268.963959
+265.997772
+263.500885
+261.785156
+260.678436
+259.832703
+259.157074
+258.772949
+258.687775
+258.697235
+258.765533
+258.751404
+258.503113
+258.026428
+257.532501
+257.265747
+257.572113
+258.619415
+260.379700
+262.604553
+264.846283
+266.785828
+270.714447
+271.029266
+270.822845
+270.120819
+269.055450
+267.379028
+265.740967
+264.233521
+262.387878
+260.484711
+259.021179
+257.235382
+255.900681
+254.511719
+251.002579
+248.309540
+248.258606
+248.981857
+249.812683
+250.839996
+251.797379
+252.427017
+252.498260
+252.765457
+253.601242
+254.423065
+255.435699
+256.653656
+258.129517
+259.548370
+260.590057
+260.701477
+260.686798
+260.622101
+260.905792
+260.850006
+261.009827
+261.527191
+262.515961
+271.518890
+271.827606
+271.955597
+272.035309
+272.287994
+272.507965
+272.627350
+272.728058
+272.865021
+272.964447
+273.001373
+272.985474
+272.926086
+272.876160
+272.850677
+272.896454
+273.191833
+273.441223
+273.699860
+273.726074
+274.204285
+274.557953
+274.742188
+274.693085
+274.565399
+274.483582
+274.443176
+274.376892
+274.278168
+274.163635
+274.032410
+273.866669
+273.647919
+273.345520
+273.040497
+272.714417
+272.538574
+272.443848
+272.477875
+272.736816
+273.032104
+273.386261
+273.679108
+273.928436
+274.113708
+274.205719
+274.248596
+274.285492
+274.354309
+274.451874
+274.552246
+274.667023
+274.760010
+274.823334
+274.849518
+274.844025
+274.863708
+274.905609
+274.935944
+274.947937
+274.921448
+274.870575
+274.776398
+274.600922
+274.326385
+273.843353
+273.264709
+271.743927
+270.968689
+269.189331
+267.882751
+266.812286
+265.737976
+264.570312
+263.305206
+262.012085
+261.010956
+260.522156
+260.523224
+260.655334
+260.951477
+261.415100
+262.028168
+262.957001
+264.139435
+265.624054
+267.299805
+268.891418
+270.065155
+271.449585
+271.680939
+271.506927
+270.984467
+270.481415
+269.705719
+268.961823
+268.373444
+271.658875
+271.964172
+272.144928
+272.241730
+272.277893
+272.254395
+272.170410
+272.075409
+272.026581
+272.048004
+272.151215
+272.212280
+272.266785
+272.283783
+272.304749
+272.269958
+272.207794
+272.053253
+271.560242
+260.486389
+261.257874
+262.219055
+263.694794
+272.160645
+272.418304
+272.498627
+272.471100
+272.407471
+272.371246
+272.388123
+272.469757
+272.517059
+272.778229
+273.005920
+273.233826
+273.555145
+273.840118
+273.998077
+274.133453
+274.339233
+274.468933
+274.486938
+274.449738
+274.410980
+274.528900
+274.778778
+275.048370
+275.376251
+275.677216
+275.976410
+276.429626
+276.972961
+277.367889
+277.409882
+277.118195
+276.829285
+276.718750
+276.700836
+276.632233
+276.487823
+276.326996
+276.174164
+275.991699
+275.811554
+275.597260
+275.307495
+275.006012
+274.751526
+274.639252
+274.760834
+274.984955
+275.135895
+275.243683
+275.402191
+275.629425
+275.811523
+275.843781
+275.792206
+275.762970
+275.804810
+275.903320
+276.010223
+276.100647
+276.153351
+276.207031
+276.251465
+276.271423
+276.304596
+276.368958
+276.456451
+276.561340
+276.664917
+276.786102
+276.910797
+276.964294
+276.956848
+276.847473
+276.503845
+275.660797
+274.836426
+274.098358
+273.389648
+272.348511
+272.424744
+271.422394
+270.162079
+268.572601
+266.545807
+264.845734
+263.863159
+263.600647
+263.784760
+264.395325
+264.868195
+265.653107
+266.823608
+268.033905
+269.270874
+270.186707
+270.969818
+272.166168
+272.242493
+272.227539
+272.192017
+272.151001
+272.252350
+272.284912
+272.246368
+272.520691
+272.757721
+273.000366
+273.174927
+273.242950
+273.183472
+273.045593
+272.918823
+272.881653
+272.952576
+273.082336
+273.184662
+273.246033
+273.310883
+273.341461
+273.308075
+273.276367
+273.169861
+272.976562
+272.798462
+272.685699
+272.786224
+273.143738
+273.594330
+273.915833
+273.919281
+273.744476
+273.607849
+273.523407
+273.498199
+273.530365
+273.601501
+273.855042
+274.201080
+274.587036
+275.033600
+275.421204
+275.703125
+275.909119
+276.153534
+276.294647
+276.265503
+276.209015
+276.265442
+276.608948
+277.140717
+277.556519
+277.862396
+278.105194
+278.421051
+278.930450
+279.433960
+279.715393
+279.647919
+279.166534
+278.745972
+278.639954
+278.716064
+278.764557
+278.676544
+278.530701
+278.422729
+278.318420
+278.244507
+278.149109
+277.983917
+277.782471
+277.602814
+277.491699
+277.519318
+277.581909
+277.527679
+277.423218
+277.408600
+277.496552
+277.549744
+277.449097
+277.267151
+277.136169
+277.151581
+277.253143
+277.327820
+277.337585
+277.309113
+277.310974
+277.332184
+277.350342
+277.371002
+277.413727
+277.501526
+277.658966
+277.901001
+278.253052
+278.599304
+278.686584
+277.688416
+277.686249
+278.073700
+277.575256
+276.995178
+276.327271
+275.642975
+275.024689
+274.384247
+273.866302
+273.626190
+273.574432
+273.555695
+273.355865
+272.845093
+272.391205
+272.477448
+272.726593
+272.828857
+272.806305
+272.693298
+272.512878
+272.317657
+272.172119
+272.102264
+274.039978
+274.109344
+274.111389
+274.056213
+273.944183
+273.887817
+273.796143
+273.622620
+273.679413
+273.936462
+274.249146
+274.508026
+274.529724
+274.380249
+274.193817
+274.073517
+274.053619
+274.114014
+274.240631
+274.344360
+274.415375
+274.496948
+274.501923
+274.427734
+274.398834
+274.333649
+274.177124
+274.047943
+274.056030
+274.325531
+274.890472
+275.531738
+275.915375
+275.773041
+275.390472
+275.153473
+275.054382
+275.012207
+275.022308
+275.101379
+275.407990
+275.867371
+276.387939
+276.937134
+277.466980
+277.906616
+278.183594
+278.396332
+278.509094
+278.499847
+278.527222
+278.689270
+279.085022
+279.602264
+279.978333
+280.203674
+280.340668
+280.567383
+280.979248
+281.248199
+281.140320
+280.822540
+280.384430
+280.063110
+280.043396
+280.266479
+280.526794
+280.571472
+280.474274
+280.417969
+280.415924
+280.448364
+280.427124
+280.329132
+280.188385
+280.039093
+279.883362
+279.736237
+279.584503
+279.419220
+279.246338
+279.086853
+278.965057
+278.836212
+278.627747
+278.368530
+278.192078
+278.218414
+278.334534
+278.380432
+278.333374
+278.239258
+278.176666
+278.153046
+278.155975
+278.183807
+278.239319
+278.356659
+278.590668
+278.973755
+279.478882
+279.805115
+278.479431
+277.843658
+279.070831
+278.827118
+278.490631
+278.067444
+277.599335
+277.165955
+276.806213
+276.346832
+275.821106
+275.448792
+275.257996
+275.093811
+274.849152
+274.545837
+274.388458
+274.431793
+274.513580
+274.496002
+274.353912
+274.117035
+273.809387
+273.603760
+273.609772
+273.778046
+276.265076
+276.390015
+276.394897
+276.369202
+276.338013
+276.287415
+276.111877
+275.803436
+275.684357
+275.814728
+276.169342
+276.441803
+276.343262
+276.037811
+275.793610
+275.691620
+275.601898
+275.468140
+275.452911
+275.606903
+275.932922
+276.254150
+276.253448
+275.992493
+275.867523
+275.944336
+276.055389
+276.143005
+276.261475
+276.608185
+277.272430
+277.931610
+278.196381
+277.948120
+277.481659
+277.219269
+277.194031
+277.273651
+277.438171
+277.666046
+278.060730
+278.497986
+278.895172
+279.328247
+279.825562
+280.230865
+280.459839
+280.616455
+280.729919
+280.807068
+280.913605
+281.068207
+281.339203
+281.665802
+281.874146
+281.948914
+281.988312
+282.153839
+282.484375
+282.571930
+282.120422
+281.533478
+281.167969
+281.029419
+281.135803
+281.504791
+281.954193
+282.128662
+282.075073
+281.980225
+281.925049
+281.906921
+281.833038
+281.668030
+281.452148
+281.239441
+281.033752
+280.820190
+280.605743
+280.435272
+280.250885
+280.021912
+279.828949
+279.673615
+279.487793
+279.306488
+279.234375
+279.299896
+279.399384
+279.433380
+279.365601
+279.216187
+279.093140
+279.039642
+279.043793
+279.104767
+279.224915
+279.418182
+279.714722
+280.150543
+280.686951
+280.958160
+278.410828
+278.998016
+279.947113
+279.610962
+279.149048
+278.749481
+278.675598
+278.907135
+279.085663
+278.902435
+278.498505
+278.107117
+277.812958
+277.511780
+277.191071
+276.865448
+276.633911
+276.555847
+276.606812
+276.616333
+276.412292
+276.089813
+275.720367
+275.505371
+275.623413
+275.919128
+278.866974
+279.017242
+279.019623
+279.044678
+279.143311
+279.154175
+279.088928
+278.939819
+278.796814
+278.760162
+278.972565
+279.032623
+278.685944
+278.180359
+277.809174
+277.604919
+277.354065
+276.982452
+276.869690
+277.302948
+278.300598
+279.315216
+279.574463
+279.134338
+278.842468
+279.066559
+279.428284
+279.560242
+279.506317
+279.662842
+280.120941
+280.484436
+280.487427
+280.248596
+279.981537
+279.929718
+280.063934
+280.268585
+280.512451
+280.719330
+280.978363
+281.181152
+281.326935
+281.514771
+281.769867
+281.966431
+282.052399
+282.137604
+282.282410
+282.468475
+282.680908
+282.900635
+283.168793
+283.418152
+283.454926
+283.341919
+283.309174
+283.461243
+283.748993
+283.839569
+278.015259
+282.732483
+282.329407
+282.269989
+282.482544
+282.884521
+283.274078
+283.420349
+283.337830
+283.156769
+282.972931
+282.811890
+282.650024
+282.447968
+282.202881
+281.965057
+281.766663
+281.597778
+281.427338
+281.297058
+281.161102
+280.974304
+280.821350
+280.715240
+280.598206
+280.538605
+280.584778
+280.668396
+280.731720
+280.741272
+280.642426
+280.449615
+280.284363
+280.229248
+280.270844
+280.380524
+280.562897
+280.803925
+281.096985
+281.480347
+281.916046
+282.167267
+279.546204
+280.074402
+280.618073
+280.696594
+280.060455
+279.596985
+279.978790
+281.135834
+281.682709
+281.395905
+280.920441
+280.587769
+280.348846
+280.102936
+279.875092
+279.585266
+279.304810
+279.165375
+279.216187
+279.200531
+278.919556
+278.615936
+278.413879
+278.335968
+278.446503
+278.633972
+281.455231
+281.611389
+281.686890
+281.870850
+282.260803
+282.373383
+282.655365
+282.881287
+282.868195
+282.631592
+282.665161
+282.500763
+281.965149
+281.389679
+280.811615
+280.496887
+280.316925
+279.790222
+279.611816
+280.481110
+282.035278
+283.469421
+283.896393
+283.460510
+283.100647
+283.203827
+283.314514
+283.142975
+282.904205
+282.801117
+282.828888
+282.789124
+282.646484
+282.568878
+282.572754
+282.626953
+282.695557
+282.778595
+282.838776
+282.876282
+282.966858
+283.005280
+283.026398
+283.078613
+283.168762
+283.247620
+283.250824
+283.314514
+283.534515
+283.828674
+284.147156
+284.447418
+284.747314
+284.977600
+284.970734
+284.808533
+284.709930
+284.794769
+285.018555
+285.176575
+284.984955
+282.542572
+284.117340
+284.151489
+284.410156
+284.664948
+284.774261
+284.692017
+284.453735
+284.167755
+283.913269
+283.696838
+283.524017
+283.380798
+283.220581
+283.034027
+282.865021
+282.752716
+282.655823
+282.597626
+282.563232
+282.475159
+282.359131
+282.272186
+282.219757
+282.257965
+282.324951
+282.339752
+282.362946
+282.361206
+282.195068
+281.978271
+281.807068
+281.735870
+281.818024
+281.997620
+282.221344
+282.465851
+282.735199
+283.045044
+283.204285
+283.303223
+283.225067
+280.283234
+281.014496
+282.368347
+281.322571
+280.663361
+281.089142
+283.009674
+283.676483
+283.140259
+282.454712
+282.256439
+282.294830
+282.338043
+282.462341
+282.444489
+282.324524
+282.225220
+282.171783
+281.982758
+281.678711
+281.583496
+281.662659
+281.635498
+281.485291
+281.393890
+283.435089
+283.570801
+283.809479
+284.233917
+284.971436
+285.555267
+286.519226
+287.048279
+287.073059
+286.590759
+286.809753
+286.840912
+286.458893
+286.117828
+285.467133
+285.300995
+285.430511
+284.920715
+284.507874
+285.090027
+286.069519
+286.704498
+286.688721
+286.365448
+286.055939
+285.880585
+285.677185
+285.340240
+285.089935
+284.906982
+284.695831
+284.504120
+284.337189
+284.258362
+284.182404
+284.128967
+284.116211
+284.152588
+284.214661
+284.359772
+284.614960
+284.769165
+284.776184
+284.728577
+284.679749
+284.651245
+284.609100
+284.683899
+284.954468
+285.273895
+285.533417
+285.716064
+285.930389
+286.246582
+286.485138
+286.489777
+286.403900
+286.385986
+286.439423
+286.480469
+286.392609
+286.099884
+285.926147
+286.065338
+286.281830
+286.279846
+286.076111
+285.800262
+285.498627
+285.218384
+285.003967
+284.836212
+284.706604
+284.624908
+284.565857
+284.478210
+284.369751
+284.299438
+284.282806
+284.325012
+284.362122
+284.300018
+284.183258
+284.084381
+284.091492
+284.156403
+284.211823
+284.229706
+284.263000
+284.198700
+283.899689
+283.670288
+283.528564
+283.443695
+283.536133
+283.778564
+284.004120
+284.246002
+284.471008
+284.560486
+284.431793
+284.346344
+280.741974
+279.108429
+278.454071
+282.496155
+282.700256
+281.932068
+281.985168
+283.801117
+285.261475
+285.256805
+284.825073
+284.885712
+285.047943
+285.023071
+285.150726
+285.224792
+285.138763
+284.980499
+284.769775
+284.421234
+284.193817
+284.219147
+284.191376
+284.001373
+283.656586
+283.449402
+285.652130
+285.717560
+285.894409
+286.320801
+286.972321
+287.686157
+288.399963
+288.954315
+289.474701
+289.867126
+290.060974
+289.996216
+289.767700
+289.459869
+289.113953
+288.907593
+288.713287
+288.419983
+288.181946
+288.069672
+288.027527
+287.910553
+287.648651
+287.381714
+287.163055
+286.926514
+286.617920
+286.278259
+286.042053
+285.841919
+285.619965
+285.422424
+285.280792
+285.173096
+285.100220
+285.136383
+285.268768
+285.463226
+285.698853
+286.072968
+286.631378
+287.002502
+286.962830
+286.653015
+286.365021
+286.193268
+286.109619
+286.158356
+286.320343
+286.468079
+286.540497
+282.316742
+283.526581
+284.467957
+288.143921
+288.404053
+288.348816
+288.204620
+288.001617
+287.765106
+287.579590
+287.439728
+287.418152
+287.559723
+287.607208
+287.351990
+286.974823
+286.705597
+286.542297
+286.413483
+286.313965
+286.249542
+286.175293
+286.138855
+286.122894
+286.115723
+286.090912
+286.071411
+286.061493
+286.097046
+286.134216
+286.158630
+286.141541
+286.045105
+286.060120
+286.123932
+286.167908
+286.267212
+286.320801
+286.127106
+285.835632
+285.592041
+285.503448
+285.436646
+285.458862
+285.642792
+285.774323
+285.846436
+285.842590
+285.756683
+285.508331
+285.215027
+280.187653
+277.929016
+279.047333
+283.485840
+283.648376
+284.570221
+283.606201
+284.962280
+286.947540
+287.692505
+287.782928
+287.731079
+287.546814
+287.388947
+287.313232
+287.248413
+287.111481
+286.918884
+286.677002
+286.435364
+286.317474
+286.287903
+286.056366
+285.799500
+285.607025
+285.598358
+287.815826
+287.847870
+287.934784
+288.120544
+288.409973
+288.612976
+288.660553
+288.867889
+289.622681
+290.815063
+291.717316
+291.900848
+291.632843
+291.260193
+290.925537
+290.608856
+290.294159
+290.026672
+289.787689
+289.496002
+289.179779
+288.906555
+288.658630
+288.440552
+288.225067
+287.976929
+287.691223
+287.405670
+287.194153
+287.009949
+286.817047
+286.637024
+286.500671
+286.410950
+286.400818
+286.529999
+286.761139
+287.080200
+287.506775
+288.115753
+288.897797
+289.311523
+280.162598
+288.288971
+287.720184
+287.468445
+287.404572
+287.403870
+287.303802
+281.890076
+281.348999
+282.851105
+284.979309
+286.534637
+289.987061
+290.402588
+290.330566
+290.038849
+289.619446
+289.195740
+288.903351
+288.796753
+288.843964
+288.917450
+288.816925
+288.491882
+288.160919
+287.967072
+287.902222
+287.867798
+287.850769
+287.847443
+287.846161
+287.870361
+287.901428
+287.936951
+287.950378
+287.924286
+287.885254
+287.881470
+287.905212
+287.947052
+288.023682
+288.083618
+288.148895
+288.206024
+288.290680
+288.311066
+288.263062
+288.109894
+287.905579
+287.669708
+287.603577
+287.501923
+287.413025
+287.402893
+287.376801
+287.307098
+287.166809
+286.947754
+286.597137
+286.098907
+285.679199
+278.495911
+280.161224
+284.164642
+282.039001
+284.617615
+284.625336
+286.333862
+288.271088
+289.552551
+289.694061
+289.435242
+289.200104
+289.073212
+288.986206
+288.875488
+288.740723
+288.589203
+288.458862
+288.411163
+288.378082
+288.282684
+288.128906
+287.956146
+287.863770
+287.823212
+289.321259
+289.252930
+289.186798
+289.114166
+288.999023
+288.662689
+288.215851
+288.893188
+286.024628
+284.168182
+284.723175
+293.258850
+293.141388
+292.806702
+292.485748
+292.157104
+291.798309
+291.453796
+291.166321
+290.884766
+290.606628
+290.377777
+290.194061
+290.000549
+289.747528
+289.477142
+289.243683
+289.050751
+288.882385
+288.692383
+288.512329
+288.381653
+288.283020
+288.224487
+288.234985
+288.347198
+288.546967
+288.851440
+289.351776
+290.084320
+290.839905
+291.083801
+279.753662
+279.925995
+280.488678
+279.807343
+280.257935
+280.924805
+282.458740
+283.678436
+286.368774
+288.661774
+290.148834
+288.921204
+291.026550
+292.042999
+291.862762
+291.452576
+291.047455
+290.696777
+290.430725
+290.302521
+290.304535
+290.301910
+290.179779
+289.963043
+289.785858
+289.680695
+289.638702
+289.628479
+289.626831
+289.629791
+289.644226
+289.685730
+289.746185
+289.809967
+289.865387
+289.890076
+289.882355
+289.894745
+289.920715
+289.954193
+290.025330
+290.115814
+290.205902
+290.271454
+290.353394
+290.359711
+290.311401
+290.152466
+290.005524
+289.805786
+289.734192
+289.598328
+289.440460
+289.259186
+289.031799
+288.825867
+288.577515
+288.301270
+287.860565
+287.095917
+286.390045
+276.211823
+279.537811
+284.495789
+283.138763
+285.102844
+287.175873
+286.810822
+289.297913
+290.892517
+291.351257
+291.085602
+290.807678
+290.689087
+290.650909
+290.600677
+290.509003
+290.389313
+290.263123
+290.160980
+290.047852
+289.927124
+289.827698
+289.695404
+289.554382
+289.415466
+290.393250
+290.209198
+289.979034
+289.646698
+289.111176
+288.228302
+288.232849
+290.025238
+286.815094
+282.847168
+281.594666
+283.535126
+294.401062
+294.256653
+294.037964
+293.880280
+293.643768
+293.261566
+292.874237
+292.576660
+292.354065
+292.153931
+291.945374
+291.700684
+291.435028
+291.201447
+291.019043
+290.889862
+290.746704
+290.550934
+290.363708
+290.257202
+290.192017
+290.155731
+290.176788
+290.266235
+290.449738
+290.706604
+291.163910
+291.826538
+292.354309
+283.564514
+283.075470
+282.623169
+283.148193
+284.259857
+284.790894
+284.071075
+284.190826
+287.397766
+291.603790
+293.262207
+292.349915
+291.898560
+291.543488
+293.286438
+293.014160
+292.631226
+292.378632
+292.182373
+292.006775
+291.897339
+291.860626
+291.841217
+291.771423
+291.692413
+291.659698
+291.639374
+291.629150
+291.609100
+291.592377
+291.588135
+291.581482
+291.586548
+291.622040
+291.681030
+291.756287
+291.850037
+291.943634
+292.021851
+292.077087
+292.116058
+292.158783
+292.216492
+292.232056
+292.232910
+292.223846
+292.250763
+292.280914
+292.188751
+292.039703
+291.775726
+291.575409
+291.381805
+291.101135
+290.799957
+290.510406
+290.208069
+289.867920
+289.527924
+288.955017
+288.046661
+287.164307
+276.955933
+279.344818
+284.930206
+286.620300
+287.154938
+287.205536
+286.837524
+289.439606
+292.110901
+293.014008
+293.005615
+292.718903
+292.499054
+292.371490
+292.319672
+292.234955
+292.065460
+291.879791
+291.714386
+291.517273
+291.324158
+291.171783
+291.002655
+290.820129
+290.599365
+291.295776
+290.936493
+290.504791
+289.892578
+288.917999
+287.647858
+289.456970
+290.754700
+289.466278
+285.027618
+282.986938
+284.096405
+295.286530
+295.401917
+295.260162
+295.182190
+295.114563
+294.916931
+294.605560
+294.313507
+294.093018
+293.848572
+293.585175
+293.341766
+293.134033
+292.967072
+292.819885
+292.690704
+292.533539
+292.355011
+292.196930
+292.068634
+291.968445
+291.884186
+291.876373
+291.976654
+292.193909
+292.444885
+292.826813
+293.333038
+293.667084
+288.203796
+286.947418
+287.037598
+288.023499
+288.828400
+289.583740
+286.984406
+287.145660
+291.378052
+293.595764
+294.155457
+293.750946
+291.541504
+291.264038
+294.332275
+294.046661
+293.734039
+293.627655
+293.600342
+293.583954
+293.564789
+293.535431
+293.496918
+293.476807
+293.481323
+293.509857
+293.545471
+293.597809
+293.628998
+293.637299
+293.618378
+293.591583
+293.597443
+293.646759
+293.685303
+293.755554
+293.864319
+293.977020
+294.039612
+294.076111
+294.119507
+294.175598
+294.178772
+294.106964
+294.018372
+293.945190
+293.870117
+293.825256
+293.735382
+293.519592
+293.207245
+292.872223
+292.544739
+292.187225
+291.839569
+291.529938
+291.187927
+290.813538
+290.407959
+289.750397
+288.827515
+288.008728
+277.443115
+277.459137
+284.165344
+288.688568
+289.414337
+288.875153
+288.508087
+290.050995
+293.083984
+294.107025
+294.504303
+294.459778
+294.181061
+293.934937
+293.755920
+293.569214
+293.343384
+293.172791
+293.009521
+292.779663
+292.532410
+292.302673
+292.091919
+291.892090
+291.632355
+291.835663
+291.343292
+290.740814
+289.937317
+288.690979
+287.441040
+286.734833
+291.289368
+291.159454
+288.255157
+285.837921
+286.575836
+289.157745
+296.336487
+296.330048
+296.212006
+288.954163
+287.554871
+295.793304
+295.607910
+295.396332
+295.133301
+294.874054
+294.697601
+294.572296
+294.440643
+294.309509
+294.163574
+294.012543
+293.861267
+293.714813
+293.564087
+293.436493
+293.352051
+293.374756
+293.531158
+293.769684
+293.999176
+294.298920
+294.702209
+295.029388
+291.572937
+291.981598
+292.789185
+292.277161
+291.259064
+289.367737
+287.776062
+289.437592
+293.522034
+294.296783
+294.449371
+292.303711
+291.007294
+295.146912
+295.384094
+295.152130
+294.882568
+294.860779
+294.987793
+295.119537
+295.205414
+295.211578
+295.207550
+295.238892
+295.283905
+295.306641
+295.366913
+295.481232
+295.580261
+295.611572
+295.582184
+295.544250
+295.560699
+295.615997
+295.693634
+295.785400
+295.893250
+295.950745
+295.931274
+295.896637
+295.873718
+295.855957
+295.782867
+295.638916
+295.483521
+295.335724
+295.157349
+294.927460
+294.669586
+294.391724
+294.089630
+293.742981
+293.365387
+292.959320
+292.574860
+292.192810
+291.801025
+291.409851
+290.960205
+290.298126
+289.491425
+288.825806
+277.846161
+276.241669
+281.621887
+289.213684
+290.526367
+290.951111
+290.692474
+290.863739
+292.914764
+292.419373
+295.204559
+295.490082
+295.460724
+295.278259
+295.057068
+294.793335
+294.530823
+294.334167
+294.171631
+293.934082
+293.611786
+293.273407
+292.984314
+292.694275
+292.308105
+292.096649
+291.531830
+290.838440
+289.910797
+288.670166
+285.336884
+288.645294
+293.072906
+291.100250
+289.406799
+286.990387
+287.514984
+289.198486
+296.998962
+297.274353
+297.252014
+290.976166
+289.557678
+296.425232
+296.321075
+296.178009
+295.989807
+295.825500
+295.731262
+295.649384
+295.555145
+295.448395
+295.312836
+295.189178
+295.080597
+294.960205
+294.844147
+294.786652
+294.804596
+294.930908
+295.145416
+295.365417
+295.525299
+295.734375
+296.023590
+296.297974
+296.493011
+293.076416
+295.032471
+293.578857
+291.733704
+290.114471
+291.922180
+294.146393
+295.072601
+296.475769
+294.575470
+292.312744
+292.296539
+296.256775
+296.491577
+296.371796
+296.212585
+296.259979
+296.448456
+296.667450
+296.810120
+296.865540
+296.892944
+296.960693
+297.050873
+297.117706
+297.219025
+297.346741
+297.441010
+297.455261
+297.439301
+297.437958
+297.431458
+297.420441
+297.429565
+297.458008
+297.477417
+297.460022
+297.420624
+297.358276
+297.254333
+297.121643
+296.940979
+296.718292
+296.494781
+296.258209
+295.986145
+295.665222
+295.321167
+294.964600
+294.619965
+294.244812
+293.837341
+293.448730
+293.077301
+292.612946
+292.124573
+291.709137
+291.201996
+290.499634
+289.781128
+289.288727
+289.270233
+277.787079
+283.211273
+289.655121
+292.303009
+293.520508
+293.854462
+294.049835
+294.113617
+292.601654
+292.824768
+296.344177
+296.536865
+296.443329
+296.204620
+295.896820
+295.608704
+295.333099
+295.013092
+294.647247
+294.285797
+293.935181
+293.547852
+293.114014
+292.623505
+292.322144
+291.698151
+290.984619
+290.117279
+289.236847
+291.332703
+292.539429
+292.529419
+290.884430
+289.377930
+287.475433
+287.633545
+289.795105
+292.185364
+297.872620
+298.005066
+294.963654
+293.153473
+296.984619
+296.899506
+296.804504
+296.662231
+296.592896
+296.569214
+296.524902
+296.471069
+296.427612
+296.359772
+296.287048
+296.231903
+296.204956
+296.233093
+296.328796
+296.479401
+296.669922
+296.839386
+296.961029
+297.037872
+297.153717
+297.329865
+297.551544
+297.784729
+297.944305
+298.056976
+292.640900
+292.971527
+294.016876
+294.201202
+295.198029
+296.872589
+295.122498
+293.724670
+293.818604
+297.130981
+297.522064
+297.666443
+297.702118
+297.746460
+297.843506
+298.002655
+298.184479
+298.330902
+298.439575
+298.524750
+298.643646
+298.789307
+298.888641
+298.937683
+298.966766
+298.983398
+298.991760
+299.008606
+299.008301
+298.974274
+298.907715
+298.815796
+298.689270
+298.573914
+298.493805
+298.434418
+298.340240
+298.179871
+297.990479
+297.756165
+297.493164
+297.184509
+296.843262
+296.492432
+296.140900
+295.780212
+295.432739
+295.083374
+294.676971
+294.239319
+293.827698
+293.392151
+292.843781
+292.286987
+291.784790
+291.170868
+290.379425
+289.688049
+289.356934
+282.514069
+283.609100
+289.651978
+291.793945
+294.104950
+295.111603
+296.135742
+296.009399
+294.173676
+292.586243
+293.111542
+293.225098
+297.424469
+297.324768
+297.052185
+296.704468
+296.311890
+295.929047
+295.558319
+295.186310
+294.823792
+294.390381
+293.902954
+293.389801
+292.877075
+292.842072
+292.223206
+291.653351
+291.186340
+290.957428
+292.978485
+292.436554
+291.584015
+290.851379
+290.137054
+288.570923
+288.037659
+290.126312
+293.203979
+296.016479
+298.358978
+298.246216
+294.330994
+297.548248
+297.477509
+297.435425
+297.341492
+297.287079
+297.282043
+297.293854
+297.307800
+297.335480
+297.342346
+297.339966
+297.388641
+297.515656
+297.713684
+297.942383
+298.133270
+298.276550
+298.332855
+298.320862
+298.294128
+298.326111
+298.462769
+298.698395
+298.931519
+299.112732
+299.222229
+299.227112
+293.868866
+293.187256
+293.997803
+293.811768
+297.848114
+297.679840
+296.229767
+297.805847
+298.246338
+298.610748
+298.795074
+298.993256
+299.197052
+299.319885
+299.410400
+299.510345
+299.638916
+299.792816
+299.949402
+300.089508
+300.193695
+300.253510
+300.248932
+300.210236
+300.176941
+300.150055
+300.128815
+300.085510
+300.008911
+299.925781
+299.810028
+299.617035
+299.416351
+299.273254
+299.137421
+298.957794
+298.735352
+298.512299
+298.268036
+298.017822
+297.734100
+297.378387
+297.002258
+296.614990
+296.246155
+295.897644
+295.553833
+295.156189
+294.706512
+294.242737
+293.717377
+293.096924
+292.401550
+291.764648
+291.064331
+290.175049
+289.532898
+289.153351
+288.543152
+289.466705
+291.497406
+292.662476
+295.351532
+296.947144
+296.876251
+295.196106
+294.099640
+293.581512
+294.036346
+293.850464
+298.094604
+298.019592
+297.743195
+297.355652
+296.971649
+296.645142
+296.289825
+295.889893
+295.468842
+294.979370
+294.442657
+293.911285
+293.409210
+293.818024
+293.303558
+292.982178
+292.942963
+293.066376
+293.601410
+292.981567
+291.411591
+291.014893
+291.320923
+289.883698
+289.632294
+290.142731
+293.214417
+295.427155
+298.418671
+298.386078
+298.150696
+297.955322
+297.976013
+298.067474
+298.097351
+298.080566
+298.071228
+298.093079
+298.155518
+298.236481
+298.299805
+298.366486
+298.499634
+298.726715
+298.997711
+299.228119
+299.343781
+299.367828
+299.328156
+299.239929
+299.131744
+299.072968
+299.136292
+299.337952
+299.558075
+299.748383
+299.867981
+299.884064
+299.804840
+299.674347
+294.436646
+295.925934
+298.722015
+298.521118
+298.380524
+298.524750
+298.951508
+299.398102
+299.756836
+300.092804
+300.359436
+300.492096
+300.547485
+300.605133
+300.687103
+300.811859
+300.975464
+301.090240
+301.121368
+301.125488
+301.121094
+301.091858
+301.041077
+300.941406
+300.849762
+300.740448
+300.638550
+300.557312
+300.445831
+300.252197
+300.023224
+299.795044
+299.564819
+299.315613
+299.052948
+298.808075
+298.549286
+298.304016
+298.068451
+297.813324
+297.513580
+297.152588
+296.779816
+296.402832
+296.039032
+295.645386
+295.200439
+294.707031
+294.151306
+293.454132
+292.686432
+291.966217
+291.118134
+290.208588
+291.867218
+288.441132
+291.549866
+293.822388
+293.409363
+295.232666
+296.244720
+296.529022
+295.597168
+294.927734
+293.896698
+293.914825
+294.143707
+294.101379
+298.530487
+298.553223
+298.376465
+298.061737
+297.775360
+297.517792
+297.175476
+296.737152
+296.271881
+295.812347
+295.328888
+294.840424
+294.356171
+294.849976
+294.495758
+294.369019
+294.419891
+294.389282
+296.702820
+296.701843
+294.873444
+293.261902
+292.115265
+290.991699
+290.919830
+291.944305
+293.715118
+294.807800
+298.385895
+298.360077
+298.266144
+298.264862
+298.426727
+298.657837
+298.826843
+298.914795
+298.973907
+299.008301
+299.042084
+299.127594
+299.252747
+299.388611
+299.548096
+299.759521
+299.968475
+300.095337
+300.115570
+300.077087
+300.008484
+299.921997
+299.805298
+299.720032
+299.694244
+299.790039
+299.939270
+300.092468
+300.190369
+300.167938
+300.033783
+299.817902
+299.547821
+299.262909
+299.121460
+299.060883
+299.054169
+299.260773
+299.715698
+300.262878
+300.690125
+301.007721
+301.227936
+301.362366
+301.412109
+301.446198
+301.468475
+301.513672
+301.579559
+301.587280
+301.578094
+301.585266
+301.589722
+301.543732
+301.427765
+301.279572
+301.183044
+301.061951
+300.931824
+300.821411
+300.705383
+300.520142
+300.278015
+300.002563
+299.727478
+299.457153
+299.181305
+298.927155
+298.659973
+298.383179
+298.148224
+297.940491
+297.693695
+297.383484
+297.042175
+296.678162
+296.312073
+295.939240
+295.549225
+295.109314
+294.595154
+293.932190
+293.159241
+292.276398
+291.246948
+290.527222
+290.844757
+292.866821
+294.952667
+294.463715
+295.459808
+296.820953
+296.431366
+296.026550
+296.129181
+296.438690
+296.309692
+295.760498
+294.690613
+294.424835
+294.939087
+298.951904
+298.915558
+298.761353
+298.539886
+298.237610
+297.859161
+297.429321
+297.006500
+296.604462
+296.185364
+295.742310
+295.291626
+295.585022
+295.438812
+295.431396
+295.370575
+295.063904
+295.051025
+297.901093
+296.928192
+295.357056
+294.413666
+292.460754
+292.355377
+291.997864
+293.243713
+298.372223
+298.398224
+298.389252
+298.433289
+298.637238
+298.958496
+299.286743
+299.560028
+299.747833
+299.878876
+299.955231
+299.999329
+300.057068
+300.166656
+300.297455
+300.420776
+300.551239
+300.660248
+300.721649
+300.746613
+300.751587
+300.739624
+300.718964
+300.692474
+300.636200
+298.146362
+300.448029
+300.467804
+300.508972
+300.450531
+300.322906
+300.140228
+299.892792
+299.643433
+299.539795
+299.669800
+298.644928
+298.981384
+298.401611
+300.853882
+301.260071
+301.523865
+301.691528
+301.829742
+301.922119
+301.932831
+301.899170
+301.862579
+301.847168
+301.836670
+301.796204
+301.717285
+301.661865
+301.681000
+301.599548
+301.420532
+301.245941
+301.163177
+301.059204
+300.915802
+300.768433
+300.612946
+300.425232
+300.170776
+299.894012
+299.631622
+299.364594
+299.085083
+298.827881
+298.569702
+298.279755
+297.998291
+297.752045
+297.485168
+297.171143
+296.827484
+296.486389
+296.165649
+295.836121
+295.495575
+295.146515
+294.767914
+294.285492
+293.583832
+292.604645
+291.629822
+290.003235
+291.972076
+293.050751
+294.747528
+295.297913
+295.996826
+297.379303
+296.489075
+296.385681
+296.562378
+297.315918
+297.450073
+297.226807
+296.610352
+296.064087
+296.817078
+299.230499
+299.204987
+299.094727
+298.833832
+298.462585
+298.056274
+297.647278
+297.278351
+296.922943
+296.539581
+296.179016
+295.849670
+296.188385
+296.230957
+296.305847
+296.200226
+295.818115
+293.745544
+296.478424
+298.015778
+297.295624
+296.032288
+294.108246
+292.908051
+290.448212
+292.081360
+293.869385
+298.484863
+298.511108
+298.670044
+299.011932
+299.472656
+299.930847
+300.301666
+300.545959
+300.681793
+300.760529
+300.815216
+300.852631
+300.890808
+300.945923
+300.999542
+301.047516
+301.097687
+301.172241
+301.252472
+301.310516
+301.361755
+301.414307
+298.886078
+301.327698
+301.122040
+300.961761
+300.972137
+300.996948
+300.860260
+300.607086
+300.433746
+300.319733
+300.252838
+297.837189
+297.504211
+297.450104
+297.046417
+301.515320
+301.813141
+301.976807
+302.027954
+302.049408
+302.090820
+302.114410
+302.085144
+301.995117
+301.917938
+301.867828
+301.819946
+301.754913
+301.617676
+301.507629
+301.487335
+301.409485
+301.242828
+301.064301
+300.961517
+300.867676
+300.716003
+300.532288
+300.354187
+300.108795
+299.772369
+299.454041
+299.229858
+298.978668
+298.740509
+298.523071
+298.258331
+297.932709
+297.613953
+297.301971
+296.984436
+296.634460
+296.262573
+295.912628
+295.610870
+295.362579
+295.132507
+294.904999
+294.691620
+294.460175
+294.066833
+293.508911
+293.237854
+292.770294
+293.455933
+295.067780
+296.574921
+296.820312
+297.472046
+299.048889
+298.478302
+297.940918
+297.527893
+298.116028
+298.255127
+298.978210
+299.759552
+298.140076
+299.491119
+299.376862
+299.260010
+299.102356
+298.787567
+298.376678
+297.944733
+297.529449
+297.185455
+296.857819
+296.540405
+296.331665
+296.219971
+297.096100
+297.260681
+297.371490
+297.273743
+294.124146
+294.905548
+295.343781
+297.027405
+298.362915
+297.244537
+294.089355
+292.797302
+289.382599
+291.934235
+295.737335
+298.635895
+298.620300
+298.822876
+299.196655
+299.733887
+300.326233
+300.804382
+301.085083
+301.239471
+301.305420
+301.321899
+301.296265
+301.269958
+301.240692
+301.211151
+301.205780
+301.248138
+301.345734
+301.473511
+301.592468
+301.709106
+298.290070
+299.702240
+301.593018
+301.433136
+298.011414
+297.947845
+301.547791
+298.350342
+301.144104
+300.966492
+301.034668
+297.685272
+301.403503
+301.625183
+301.781311
+301.912659
+302.060730
+302.219849
+302.264252
+302.225891
+302.166870
+302.125977
+302.093994
+302.039490
+301.956177
+301.837952
+301.776398
+301.724792
+301.624329
+301.473602
+301.354553
+301.272644
+301.189209
+301.075592
+300.926025
+300.791046
+300.687805
+300.546295
+300.361298
+300.123016
+299.832947
+299.507019
+299.170135
+298.917542
+298.684113
+298.466858
+298.272705
+297.991882
+297.692749
+297.419037
+297.112396
+296.759796
+296.381317
+296.034821
+295.738892
+295.501587
+295.370972
+295.329529
+295.285034
+295.263550
+295.315277
+295.409241
+295.586029
+296.123505
+294.539124
+294.463440
+296.096466
+298.150757
+297.633392
+297.931976
+298.936829
+299.181793
+298.539917
+298.741241
+299.055450
+298.954681
+300.330414
+300.038605
+299.891022
+299.768799
+299.549622
+299.321991
+299.121460
+298.798981
+298.392334
+297.956360
+297.581573
+297.280609
+296.991760
+296.781006
+296.769409
+296.915405
+297.958008
+298.229858
+298.418762
+298.364349
+294.698730
+294.817871
+295.047760
+296.540619
+297.193054
+296.918610
+295.346863
+294.692749
+293.746643
+294.313599
+297.404724
+297.895386
+297.997803
+298.774231
+299.115723
+299.658356
+300.320587
+300.905182
+301.289093
+301.509888
+301.579376
+301.535309
+301.419678
+301.308380
+301.221710
+301.147614
+301.145325
+301.206543
+301.315613
+301.486938
+301.719574
+301.943115
+296.955872
+301.899109
+301.758362
+301.716949
+297.252502
+297.132080
+297.507355
+301.880432
+301.650360
+301.483032
+301.557312
+301.747192
+301.922791
+302.030487
+302.077942
+302.136292
+302.225861
+302.306854
+302.341888
+302.317413
+302.256439
+302.182434
+302.116669
+302.048431
+301.989655
+301.911560
+301.832977
+301.735291
+301.638184
+301.503204
+301.389008
+301.275726
+301.186340
+301.092407
+300.972198
+300.833649
+300.712616
+300.593262
+300.451477
+300.222656
+299.958191
+299.701172
+299.452179
+299.226105
+298.956177
+298.703766
+298.523407
+298.315002
+298.115997
+297.939056
+297.704651
+297.429291
+297.163818
+296.968384
+296.837677
+296.758698
+296.812164
+296.990326
+297.169525
+297.297852
+297.443085
+297.709137
+298.099762
+298.669189
+295.777008
+294.405334
+295.476257
+297.982971
+297.852753
+296.755646
+297.511261
+298.853027
+299.153625
+298.848236
+298.858795
+300.835052
+300.610046
+300.446320
+300.363098
+300.204926
+299.928375
+299.649719
+299.458649
+299.221252
+298.885864
+298.519257
+298.250305
+298.056519
+297.861603
+297.673065
+297.571045
+297.716766
+298.158813
+298.555237
+298.881836
+294.619904
+294.836426
+295.747772
+297.301727
+297.678925
+296.904419
+296.889771
+298.362396
+298.671906
+297.682648
+295.565277
+293.900085
+294.643188
+296.873535
+297.309448
+298.834442
+299.245850
+299.893921
+300.604584
+301.148010
+301.451508
+301.531158
+301.473755
+301.294128
+301.088501
+300.947693
+300.964783
+301.049866
+301.146973
+301.249146
+301.424500
+301.723328
+302.029938
+298.760773
+301.975098
+301.862762
+301.847748
+301.908936
+298.265533
+299.400574
+301.991730
+301.886993
+301.798615
+301.815735
+301.906067
+302.023804
+302.104004
+302.129761
+302.162628
+302.239197
+302.311462
+302.360107
+302.380005
+302.378113
+302.354065
+302.293152
+302.218323
+302.148682
+302.082397
+301.998260
+301.888214
+301.731445
+301.599121
+301.505127
+301.422089
+301.363617
+301.305145
+301.226501
+301.116119
+301.007477
+300.916412
+300.844299
+300.711029
+300.526978
+300.342773
+300.209686
+300.075500
+299.861359
+299.642578
+299.507996
+299.402771
+299.267975
+299.127441
+299.000916
+298.934113
+298.914062
+298.895355
+298.857574
+298.862366
+298.974548
+299.161285
+299.315521
+299.394348
+299.438477
+299.565155
+299.790253
+300.063110
+300.340698
+294.683319
+294.706940
+298.071381
+298.361664
+297.090668
+297.561737
+298.202148
+300.460358
+299.718323
+301.159485
+301.116547
+301.051514
+300.992950
+300.888519
+300.701996
+300.450531
+300.208069
+300.047577
+299.910065
+299.706726
+299.447601
+299.257141
+299.136749
+298.965515
+298.581024
+298.113800
+297.990295
+296.335297
+297.848236
+296.904510
+295.924194
+297.890717
+300.567017
+299.672394
+298.758606
+297.212311
+297.660400
+300.895203
+301.447784
+298.483917
+292.571472
+291.851959
+293.469208
+295.956665
+299.247742
+298.763031
+298.772339
+299.248383
+300.010040
+300.680542
+301.056305
+301.198334
+301.184021
+300.990021
+300.718750
+300.691803
+298.045074
+301.138367
+301.217407
+301.268280
+301.376343
+301.609406
+301.908020
+302.040894
+301.973267
+301.861389
+301.808960
+301.840576
+301.924774
+301.977783
+301.974518
+301.961761
+301.963165
+301.956757
+301.975983
+302.035706
+302.092255
+302.115234
+302.150848
+302.227173
+302.301361
+302.367706
+302.420074
+302.461823
+302.502014
+302.488037
+302.409424
+302.297394
+302.195587
+302.078461
+301.924042
+301.755096
+301.602539
+301.493073
+301.450775
+301.441589
+301.436310
+301.388397
+301.308044
+301.223572
+301.155914
+301.122314
+301.086975
+300.987915
+300.858612
+300.770966
+300.714172
+300.641968
+300.566376
+300.481262
+300.388306
+300.277069
+300.189301
+300.147308
+300.169434
+300.220123
+300.250305
+300.262299
+300.299683
+300.383331
+300.461975
+300.481781
+300.457520
+300.453156
+300.577240
+300.775696
+300.924866
+301.056152
+296.442230
+296.018890
+298.283173
+299.887909
+299.382843
+299.440094
+299.333771
+301.462677
+301.409149
+301.413177
+301.453461
+301.425568
+301.298767
+301.122833
+300.947937
+300.758911
+300.585632
+300.433044
+300.315979
+300.193939
+300.029327
+299.897705
+299.779358
+296.480194
+296.359222
+295.964600
+295.338531
+297.145325
+297.757751
+298.607147
+299.284363
+300.183014
+300.698364
+301.343536
+300.280518
+298.442169
+297.867249
+300.332153
+302.059967
+297.745148
+293.873230
+292.992645
+296.687408
+297.237000
+300.133179
+298.173553
+298.539307
+298.746063
+299.390381
+300.055908
+300.548645
+300.837769
+300.914886
+300.737610
+300.533051
+300.132355
+301.193481
+301.408173
+301.414490
+301.371338
+301.360077
+301.468903
+301.745941
+301.958130
+301.966095
+300.648376
+301.734589
+301.742157
+301.849640
+301.954376
+301.991852
+302.030487
+302.113129
+302.046600
+302.041595
+302.060760
+302.091370
+302.122192
+302.134216
+302.208038
+302.311188
+302.393433
+302.431213
+302.448090
+302.498199
+302.482086
+302.335510
+302.238098
+302.149994
+302.024628
+301.871704
+301.707947
+301.523163
+301.368622
+301.301483
+301.276306
+301.258118
+301.206116
+301.135162
+301.084351
+301.057220
+301.048676
+301.037903
+300.981293
+300.911896
+300.861694
+300.846191
+300.851807
+300.866669
+300.820007
+300.758820
+300.732819
+300.759918
+300.778961
+300.797821
+300.846802
+300.913788
+300.978363
+301.060852
+301.148621
+301.213257
+301.228180
+301.200897
+301.183777
+301.283844
+301.434235
+301.495728
+301.495605
+301.468353
+299.373444
+299.477448
+300.454193
+301.025909
+300.564484
+301.696198
+301.634003
+301.536865
+301.484222
+301.467804
+301.359985
+301.171204
+300.985474
+300.848083
+300.743073
+300.635132
+300.514984
+300.400604
+300.331543
+300.297729
+300.241089
+298.342529
+298.234650
+298.262543
+297.953857
+297.440887
+302.950104
+301.960205
+301.894623
+301.283752
+302.746124
+301.734589
+304.326141
+303.492493
+303.233337
+302.275238
+303.477081
+302.829132
+299.862762
+296.475189
+297.584595
+297.827118
+302.988068
+301.515656
+299.585388
+298.464966
+298.407410
+298.880249
+299.521362
+300.122040
+300.563416
+300.733032
+300.630615
+298.753418
+301.031494
+301.488800
+301.645325
+301.596344
+301.490417
+301.385498
+301.418121
+297.992859
+297.768768
+299.624847
+301.261780
+301.815125
+301.780640
+301.857819
+301.967255
+302.033325
+302.174561
+302.212067
+302.166595
+302.270142
+302.308228
+302.319794
+302.330353
+302.257812
+302.326233
+302.378937
+302.483704
+302.386230
+302.341888
+302.202850
+302.307983
+302.155945
+302.001678
+301.957367
+301.889771
+301.787354
+301.650574
+301.452393
+301.280975
+301.156830
+301.019775
+300.891083
+300.794678
+300.707764
+300.635742
+300.615875
+300.602325
+300.571838
+300.537506
+300.521027
+300.523376
+300.555786
+300.625702
+300.694580
+300.704071
+300.712952
+300.784058
+300.892120
+300.982758
+301.062439
+301.174438
+301.296631
+301.466248
+301.658447
+301.822784
+301.931976
+301.992004
+301.972717
+301.916382
+301.876129
+298.363373
+301.768646
+301.660309
+301.549438
+301.445129
+301.448120
+301.540558
+301.621704
+301.674805
+301.653870
+301.548645
+301.398407
+301.235779
+301.061981
+300.851135
+300.651184
+300.496338
+300.398438
+300.379730
+300.382294
+300.331085
+300.254364
+300.294647
+300.486237
+300.524536
+300.744110
+301.927887
+303.189362
+303.469482
+304.991486
+306.292419
+307.250702
+307.270142
+303.888580
+304.452728
+305.322388
+306.232147
+305.622467
+303.816803
+305.418213
+306.091248
+306.394989
+303.986298
+300.683990
+298.290253
+304.405518
+300.126129
+301.697235
+298.898529
+298.484833
+298.119751
+298.499603
+299.220123
+299.906647
+300.409576
+300.640686
+300.645325
+299.342163
+300.652435
+301.654053
+301.788513
+301.740967
+301.605499
+301.455872
+301.445831
+299.277863
+299.184021
+299.939728
+301.156616
+302.046051
+301.922821
+301.924805
+302.022858
+301.534454
+302.301147
+302.147858
+302.100922
+302.343445
+302.468689
+302.444641
+302.386444
+302.327240
+302.388641
+302.476654
+302.550323
+302.463654
+302.375763
+302.160065
+302.113159
+302.134644
+302.024933
+301.863434
+301.770905
+301.693268
+301.568207
+301.400452
+301.247375
+301.083923
+300.866516
+300.655548
+300.510071
+300.355103
+300.187103
+300.046173
+299.928070
+299.808868
+299.727173
+299.683563
+299.682770
+299.752655
+299.881470
+299.989075
+300.047241
+300.158356
+300.348114
+300.546051
+300.754181
+300.969788
+301.202576
+301.463287
+301.811096
+302.140350
+302.338104
+302.385773
+302.411072
+299.930969
+299.098663
+298.610138
+299.703888
+301.984924
+301.858398
+301.744293
+301.659882
+301.656219
+301.716339
+301.727631
+301.643127
+301.501770
+301.319214
+301.105316
+300.871155
+300.595795
+300.327515
+300.110657
+299.924622
+299.785736
+299.740417
+299.759491
+299.720428
+299.658936
+299.824097
+300.265076
+300.287964
+304.994446
+306.411713
+304.711365
+304.706909
+305.189178
+305.429932
+306.707062
+307.168304
+304.022766
+304.071625
+304.671631
+304.795380
+305.136932
+305.385864
+306.360565
+307.219391
+307.541229
+307.109131
+303.669342
+304.681427
+301.656586
+303.716614
+304.827911
+305.471313
+302.574463
+298.533691
+298.461487
+299.215485
+299.959534
+300.435822
+300.680298
+298.407349
+299.681274
+300.204529
+301.612762
+301.851196
+301.859283
+301.718475
+301.528625
+299.713715
+299.896881
+301.067444
+300.469025
+302.386993
+302.138519
+301.942841
+301.935272
+302.003845
+302.069397
+302.191589
+302.030975
+301.915894
+302.050323
+302.359009
+302.424957
+302.328308
+302.346283
+302.274292
+302.550568
+302.655701
+302.585358
+302.488281
+302.431732
+302.255249
+302.181274
+302.004639
+301.933136
+301.796265
+301.633331
+301.489166
+301.335785
+301.188263
+301.011627
+300.782471
+300.537750
+300.350555
+300.162323
+299.901581
+299.602386
+299.327454
+299.078857
+298.877045
+298.717834
+298.586731
+298.546204
+298.590271
+298.631012
+298.681763
+298.835938
+299.115112
+299.431183
+299.814697
+300.267029
+300.812225
+301.452179
+302.086639
+302.475098
+297.745239
+298.293030
+299.198151
+300.848663
+300.831238
+302.308929
+302.322662
+302.288849
+302.227081
+302.099915
+301.993073
+299.521118
+301.811493
+301.698639
+301.523468
+301.340729
+301.146545
+300.912567
+300.648224
+300.352570
+300.063904
+299.800812
+299.536438
+299.297913
+299.129242
+298.982422
+298.840759
+298.725952
+298.814728
+299.103912
+299.030212
+307.551544
+305.832031
+304.066986
+305.053955
+305.198090
+306.606659
+305.583832
+305.263794
+303.308533
+301.670532
+300.473450
+300.460724
+301.296204
+302.777374
+304.766205
+306.551849
+307.132446
+307.905090
+303.746979
+304.186920
+305.452393
+304.273834
+306.626068
+309.547180
+307.058472
+304.161865
+299.372681
+299.794983
+300.264435
+300.601837
+300.766418
+299.383820
+299.647125
+300.793854
+302.733887
+303.889862
+302.660675
+301.650482
+300.908539
+299.962219
+298.238312
+298.449005
+298.282166
+298.399414
+299.606323
+301.643585
+301.646271
+301.701202
+301.953583
+302.131195
+302.066498
+301.888245
+301.794067
+301.922272
+302.031982
+302.096619
+302.163361
+302.117279
+302.352814
+302.559052
+302.605804
+302.409027
+302.291321
+302.155762
+302.169586
+301.934204
+301.886688
+301.690948
+301.501740
+301.335632
+301.165314
+300.990417
+300.801483
+300.592255
+300.373291
+300.198608
+300.000092
+299.696869
+299.302063
+298.921387
+298.566498
+298.246185
+297.926147
+297.612335
+297.358337
+297.182861
+297.050751
+296.996887
+297.080872
+297.353638
+297.768982
+298.268219
+298.978363
+300.082367
+301.408264
+302.360596
+298.118622
+294.244843
+296.106506
+302.224121
+302.274139
+302.296661
+301.764587
+302.498749
+302.589142
+302.520844
+302.296967
+302.120667
+301.973114
+301.837463
+301.590363
+301.357880
+301.209198
+301.039917
+300.811737
+300.551208
+300.261902
+299.971466
+299.669922
+299.347351
+299.044586
+298.741852
+298.447113
+298.191132
+297.967957
+297.758209
+297.408081
+300.488251
+307.019409
+305.900665
+304.456787
+302.292206
+304.204651
+305.554138
+305.084290
+302.931793
+300.088287
+298.077545
+297.818085
+298.994171
+299.939545
+301.370789
+303.266266
+304.862366
+305.910950
+306.007721
+302.855713
+302.294617
+302.692566
+304.474396
+307.378143
+309.101074
+305.109131
+303.951965
+301.303009
+300.894928
+300.596680
+300.610229
+302.289093
+300.998169
+301.370148
+302.172791
+303.530121
+302.795898
+302.661041
+302.381165
+300.854584
+299.559937
+295.856201
+295.160126
+296.914185
+297.370667
+298.733215
+300.440430
+300.495270
+300.865448
+301.251221
+301.772980
+301.928070
+301.713470
+301.663422
+301.742584
+301.824524
+301.855896
+301.861176
+302.001709
+302.088562
+302.106781
+302.177582
+302.106750
+302.025757
+301.824158
+301.735046
+301.570129
+301.479187
+301.329773
+301.182037
+301.021759
+300.842377
+300.664154
+300.482758
+300.296204
+300.126831
+299.973083
+299.782440
+299.479645
+299.088623
+298.682190
+298.266663
+297.847046
+297.424438
+296.974701
+296.507599
+296.106567
+295.779877
+295.565979
+295.518433
+295.691528
+296.032562
+296.487213
+297.412872
+299.289673
+301.439972
+299.616730
+295.322235
+294.984894
+296.014008
+302.223236
+302.391083
+302.445831
+302.499176
+302.598053
+302.592621
+302.481476
+302.189758
+302.033539
+301.930634
+301.813293
+301.535919
+301.269684
+301.142700
+300.988953
+300.774994
+300.516724
+300.249390
+299.951752
+299.632599
+299.304840
+298.963226
+298.612610
+298.259613
+297.928040
+297.586639
+297.164337
+296.462219
+295.597900
+305.801086
+305.203827
+303.030365
+300.201935
+302.094727
+304.296631
+304.083130
+301.402374
+298.825562
+297.090698
+297.329010
+298.553925
+299.361176
+300.682343
+302.527252
+303.795166
+304.806396
+302.247467
+300.071289
+300.968719
+300.671021
+302.833374
+305.192139
+304.987854
+305.222412
+300.102448
+303.753662
+302.198090
+302.358887
+303.937042
+305.698364
+305.730103
+304.368225
+302.199890
+299.997284
+297.279663
+294.609161
+293.448578
+294.210938
+293.251495
+291.978058
+293.178925
+297.029999
+298.598907
+299.478485
+300.304443
+300.666382
+300.146362
+300.928467
+301.330566
+301.730316
+301.655640
+301.550629
+301.542847
+301.627533
+301.547485
+301.419983
+301.534973
+301.696503
+301.732452
+301.683838
+301.622406
+301.597443
+301.478760
+301.398590
+301.258453
+301.051239
+300.877502
+300.700684
+300.548950
+300.408630
+300.263519
+300.108765
+299.956360
+299.798889
+299.642944
+299.466553
+299.213593
+298.877106
+298.500977
+298.071960
+297.568787
+297.061066
+296.539642
+295.981812
+295.450256
+294.981995
+294.598358
+294.337311
+294.266632
+294.402374
+294.765717
+295.857178
+298.258820
+299.574524
+299.851685
+297.551666
+295.929596
+299.374786
+302.211975
+302.517670
+302.544922
+302.523834
+302.706726
+300.810455
+302.437469
+302.094025
+301.893555
+301.788910
+301.667603
+301.525604
+301.376099
+301.184784
+300.953583
+300.745758
+300.517639
+300.249725
+299.958344
+299.646912
+299.328400
+298.996826
+298.633453
+298.256775
+297.873810
+297.448761
+296.966095
+296.310883
+295.497681
+294.826111
+303.483643
+302.670074
+301.004486
+302.024200
+300.528046
+300.934143
+299.461792
+297.651245
+296.781342
+296.834473
+297.592316
+295.958801
+298.043488
+299.560181
+300.446259
+300.791656
+302.470917
+302.831207
+301.594849
+302.681580
+303.752014
+301.188690
+297.052612
+295.676270
+295.371277
+297.403412
+297.658722
+298.580780
+300.751312
+305.886810
+306.856689
+302.590057
+295.740997
+291.926331
+289.706146
+287.588928
+288.504944
+286.694946
+284.176422
+285.776306
+291.207489
+296.253693
+299.591248
+299.820648
+300.645782
+300.900665
+300.941986
+300.726013
+300.972839
+301.371735
+301.515747
+301.512512
+301.448303
+301.430603
+301.324860
+301.105743
+301.047913
+301.136810
+301.102142
+301.042603
+301.005859
+300.955414
+300.855164
+300.767731
+300.679901
+300.485046
+300.293335
+300.068817
+299.926544
+299.824188
+299.721252
+299.605682
+299.466248
+299.309998
+299.138275
+298.987671
+298.779083
+298.492004
+298.174805
+297.789124
+297.287048
+296.741760
+296.183563
+295.634827
+295.057831
+294.472809
+293.888153
+293.357025
+293.004425
+292.975403
+293.414429
+294.606537
+299.408722
+303.931549
+301.345581
+300.344269
+299.941528
+301.003784
+301.121887
+302.407562
+299.685211
+302.230103
+302.175323
+300.012115
+302.022736
+301.653168
+301.415039
+301.393433
+301.302979
+301.272980
+301.246918
+301.124603
+300.858521
+300.647919
+300.455963
+300.166931
+299.897644
+299.609375
+299.312317
+299.010864
+298.672241
+298.293457
+297.878113
+297.426453
+296.926544
+296.369690
+295.720886
+295.035431
+294.563568
+299.421509
+299.418671
+299.967041
+295.743347
+296.960297
+297.388367
+297.366272
+297.061401
+297.153778
+299.180267
+299.112885
+295.713867
+298.707306
+298.949524
+299.535736
+300.362823
+302.668213
+304.464172
+304.334137
+301.749329
+296.251770
+293.219177
+290.234589
+291.887909
+291.941986
+293.843719
+293.789978
+296.581726
+299.465546
+299.401306
+292.697479
+286.152710
+282.887421
+282.326080
+281.362305
+283.588501
+284.254822
+284.451477
+285.828522
+289.790619
+295.984558
+298.658539
+299.961548
+301.563660
+302.966858
+302.674316
+300.817505
+299.330994
+300.347107
+300.663452
+300.840637
+301.144684
+300.920624
+300.931885
+300.776337
+300.557678
+300.480438
+300.359344
+300.203186
+300.087677
+299.974396
+299.814240
+299.655731
+299.608490
+299.357880
+299.236420
+299.151184
+299.047577
+298.967377
+298.884277
+298.792328
+298.680176
+298.544495
+298.396149
+298.251953
+298.079956
+297.842041
+297.578918
+297.259003
+296.858124
+296.368866
+295.839569
+295.285065
+294.656311
+293.953918
+293.179535
+292.359772
+291.739960
+291.716156
+292.436371
+299.293396
+303.045380
+302.220215
+301.706573
+301.432037
+303.447418
+304.893005
+303.477478
+301.021393
+300.019287
+300.730408
+301.343048
+299.311371
+301.796967
+301.394409
+300.884247
+300.690247
+300.628418
+300.672028
+300.647308
+300.545319
+300.414368
+300.253937
+300.102478
+299.891937
+299.669891
+299.390625
+299.106354
+298.812347
+298.507538
+298.152679
+297.753204
+297.339355
+296.872894
+296.365814
+295.813263
+295.252930
+294.813446
+295.113556
+294.755402
+294.986511
+293.457764
+294.789520
+295.631317
+296.693237
+298.509827
+298.828979
+298.924225
+298.737305
+298.290527
+298.073303
+298.437286
+299.283875
+300.108398
+300.171936
+303.906677
+302.970551
+299.990601
+295.965179
+293.225952
+292.254669
+291.845520
+291.572479
+290.479004
+291.076782
+291.170135
+289.754425
+287.061584
+284.064606
+282.807343
+281.942200
+282.732330
+283.481079
+285.574219
+286.276459
+286.455200
+287.185242
+292.246735
+295.703247
+299.095001
+301.855347
+303.831299
+305.358856
+305.079865
+296.845276
+298.094452
+298.024231
+298.707458
+297.712677
+297.699677
+297.421448
+299.666870
+300.068420
+299.807373
+299.683075
+299.562866
+299.238831
+298.982880
+298.882294
+298.664062
+298.386261
+298.279449
+298.087585
+297.932007
+297.808472
+297.718628
+297.657745
+297.593414
+297.531006
+297.457092
+297.369171
+297.265411
+297.137695
+296.992615
+296.809448
+296.604431
+296.359558
+296.051819
+295.667145
+295.213531
+294.706940
+294.082794
+293.326508
+292.364288
+291.200378
+290.285461
+290.281281
+296.628448
+302.099487
+302.837402
+299.096619
+298.140900
+299.401306
+301.917572
+304.040771
+302.881744
+302.096375
+302.703064
+302.649506
+301.481323
+300.612274
+299.112152
+300.565369
+300.406586
+300.443329
+300.174561
+300.002136
+299.867218
+299.723511
+299.579529
+299.511261
+299.454163
+299.249054
+299.089081
+298.867004
+298.604797
+298.299744
+297.961823
+297.601471
+297.212280
+296.863586
+296.512878
+296.102905
+295.617584
+295.147766
+294.787354
+294.624817
+293.441010
+291.247864
+296.962402
+297.419434
+297.569366
+297.754547
+298.037659
+298.274658
+298.333374
+298.130402
+292.202515
+297.337585
+293.012238
+292.849945
+292.584045
+293.673340
+296.287567
+295.282288
+294.423798
+295.498810
+297.950409
+298.175171
+295.257050
+293.142242
+293.708221
+292.763275
+290.063263
+287.023499
+284.275604
+284.955780
+287.595520
+287.350311
+285.841980
+285.082092
+287.199707
+289.274048
+290.592010
+291.785828
+294.066223
+297.106903
+300.612457
+302.468231
+301.962524
+301.741547
+300.114594
+295.991669
+295.684601
+298.056335
+296.704651
+297.592194
+298.177246
+298.155609
+297.360809
+297.187531
+297.553680
+297.506653
+297.397400
+297.204163
+296.904327
+296.828461
+296.674347
+296.485809
+296.193726
+296.024963
+295.892487
+295.771759
+295.726440
+295.715271
+295.677216
+295.625305
+295.585480
+295.562775
+295.522522
+295.464691
+295.385010
+295.262726
+295.111084
+294.926727
+294.710815
+294.460602
+294.142456
+293.746460
+293.250977
+292.577240
+291.545502
+290.019623
+288.795898
+293.294312
+296.716797
+301.417419
+300.553680
+297.979523
+293.763580
+296.035980
+299.090302
+301.215851
+300.486481
+299.572998
+300.784698
+300.622650
+301.042603
+300.069733
+300.128326
+299.823395
+297.870361
+299.566223
+300.084076
+300.150818
+299.793762
+299.422485
+299.226257
+299.087860
+298.920258
+298.553619
+298.254639
+298.013672
+297.763245
+297.462250
+297.078156
+296.639038
+296.237274
+295.967529
+295.712311
+295.407898
+295.014526
+294.542755
+294.102631
+293.952332
+293.632782
+292.706757
+291.928467
+296.675720
+296.803223
+296.976410
+297.242493
+297.468933
+291.098633
+288.933533
+289.673676
+289.768768
+289.757263
+288.766327
+289.317688
+288.643738
+288.186707
+289.885406
+291.209106
+295.085297
+295.881714
+295.919769
+298.113831
+297.031067
+296.097412
+295.568542
+293.139465
+289.733368
+287.455688
+288.870972
+290.752258
+292.561249
+289.734314
+288.709412
+288.439880
+289.886993
+290.282013
+290.775330
+294.823029
+297.306274
+298.111908
+297.630402
+296.591217
+294.211029
+293.678894
+293.853851
+295.818726
+296.959595
+294.972137
+294.920410
+295.261688
+296.304810
+297.691895
+293.429901
+293.354797
+293.962189
+294.326874
+294.001648
+293.212128
+292.885620
+292.854248
+293.141815
+293.225098
+292.951263
+292.860260
+292.838898
+292.858704
+292.897797
+292.904694
+292.906494
+292.918793
+292.971527
+293.030823
+293.067688
+293.084381
+293.069885
+292.990021
+292.882599
+292.805023
+292.724884
+292.602661
+292.403137
+292.143555
+291.742065
+290.891327
+289.303528
+288.964691
+291.270477
+295.180328
+298.883453
+297.914490
+297.807220
+294.924835
+294.526031
+296.403503
+297.687805
+296.973236
+296.265656
+297.214569
+297.441559
+297.381683
+295.895264
+296.624512
+297.034851
+296.638397
+293.850189
+293.972321
+296.441101
+297.800964
+297.975922
+298.107758
+297.617462
+296.927521
+296.946198
+297.153534
+296.795349
+296.556213
+296.398682
+296.060455
+295.588989
+295.126923
+294.875397
+294.595490
+294.312897
+294.001038
+293.567261
+293.030029
+293.302765
+293.158264
+292.883148
+292.102203
+293.242157
+293.503326
+295.974396
+293.326263
+291.883423
+291.435364
+291.310089
+290.428009
+289.687103
+289.667664
+295.529694
+295.652832
+295.685120
+295.605255
+290.002838
+291.046387
+292.908020
+294.577454
+297.472656
+297.264191
+293.076965
+294.451324
+296.201508
+295.230469
+293.910583
+292.614014
+292.236023
+292.400574
+292.011597
+292.195038
+293.238190
+293.823303
+292.376526
+291.053253
+291.006470
+293.480103
+296.285370
+296.188934
+295.093689
+294.221558
+293.329132
+290.981873
+291.743103
+293.265076
+292.926727
+292.801697
+291.811157
+291.960236
+293.124512
+292.822876
+293.127563
+288.209167
+287.934418
+288.749634
+289.730347
+289.755615
+289.440063
+288.744751
+288.182373
+288.179321
+288.521973
+288.949493
+289.255035
+289.366516
+289.427002
+289.503326
+289.595123
+289.698456
+289.833130
+289.978058
+290.093994
+290.195343
+290.311951
+290.396301
+290.444489
+290.515350
+290.624664
+290.727020
+290.780121
+290.806305
+290.755127
+290.307953
+289.069183
+285.902466
+286.913635
+289.391418
+293.178589
+295.527100
+297.573181
+300.425720
+298.371338
+298.324066
+297.302795
+296.942139
+296.476410
+295.965149
+293.814117
+294.755920
+293.213257
+292.017029
+293.587341
+294.177582
+296.185577
+286.829041
+289.201996
+291.021576
+291.690735
+292.546082
+291.982452
+290.474884
+291.793396
+294.731659
+295.205658
+294.542969
+294.425537
+294.317902
+294.052460
+293.683105
+293.412872
+293.155914
+292.958801
+292.750732
+292.462524
+292.079651
+291.954834
+289.706390
+293.372589
+291.808685
+290.876587
+291.196594
+290.482056
+290.536346
+291.496490
+292.665405
+292.886139
+292.482697
+292.504211
+293.113892
+291.983704
+292.633911
+292.441803
+294.089539
+292.827362
+291.889038
+292.237488
+293.777954
+293.745087
+294.569031
+292.030548
+291.951721
+294.917877
+296.342987
+296.616364
+297.011383
+297.269775
+295.423676
+293.147705
+291.759827
+291.808411
+291.689606
+290.620789
+289.431396
+289.608795
+290.725494
+293.109192
+295.576630
+295.918335
+295.450195
+294.173096
+290.929932
+289.442108
+289.385986
+289.115936
+288.417755
+287.902557
+287.580505
+287.133881
+289.772247
+288.120148
+286.866577
+285.093842
+283.322815
+284.449982
+285.715637
+286.339844
+286.223907
+285.611115
+285.217316
+285.374908
+285.742371
+286.075226
+286.213837
+286.269531
+286.379242
+286.533661
+286.706573
+286.887695
+287.078796
+287.247620
+287.407074
+287.614685
+287.854218
+288.064667
+288.268311
+288.479004
+288.720581
+289.002167
+289.308258
+289.579468
+289.490662
+288.648712
+285.440186
+286.210602
+285.765472
+289.552734
+294.216858
+297.963867
+301.654938
+302.736450
+300.957672
+299.744293
+297.207581
+297.460693
+296.338501
+292.990601
+291.859253
+289.745819
+291.035614
+293.000275
+294.951294
+296.790405
+297.077240
+295.380859
+289.208862
+288.317047
+287.566101
+287.041473
+286.155792
+286.521881
+289.215027
+291.737122
+292.174164
+291.779877
+291.626587
+291.756042
+291.714539
+291.604370
+291.543854
+291.480072
+291.402557
+291.284821
+291.147491
+291.100067
+291.307037
+291.721954
+289.838562
+290.430939
+289.285065
+288.332733
+289.355560
+290.625397
+292.103699
+292.559174
+293.117950
+292.656250
+292.724670
+292.659149
+293.004486
+294.114288
+294.067169
+294.641083
+294.396454
+294.981079
+293.704773
+292.791229
+292.888428
+292.915649
+292.191193
+292.565796
+293.528992
+294.465607
+295.954285
+297.402161
+296.804413
+294.575378
+292.429749
+289.345795
+288.511688
+286.596466
+287.846985
+285.151581
+284.705109
+286.582489
+290.348114
+293.109283
+293.444733
+292.507507
+290.938202
+288.180908
+286.515656
+286.935822
+288.018402
+287.261688
+286.899017
+287.745789
+286.813141
+286.502899
+285.546448
+284.738617
+282.560730
+282.261627
+283.315399
+284.141418
+284.408081
+284.176025
+283.920563
+283.819183
+283.876709
+283.892609
+283.931702
+284.012177
+284.138092
+284.326385
+284.558014
+284.807922
+285.047607
+285.262299
+285.439178
+285.670837
+285.933685
+286.183777
+286.454132
+286.720123
+287.057709
+287.519684
+288.013580
+288.324493
+288.148651
+287.490601
+284.279968
+284.191101
+284.142975
+286.769653
+290.928741
+297.216583
+301.250732
+302.908569
+301.762329
+299.528198
+297.117523
+295.208710
+293.490814
+290.954529
+290.478851
+289.116333
+289.459076
+291.756500
+294.006683
+295.990173
+296.947662
+296.035736
+286.808167
+287.006500
+292.812042
+284.573334
+283.868988
+284.017120
+285.539642
+288.352570
+289.476990
+289.290863
+289.379822
+289.666870
+289.747986
+289.784027
+289.875519
+289.951508
+289.989594
+289.986023
+289.970032
+289.926605
+289.935089
+287.847168
+286.928772
+289.564758
+288.335663
+290.085602
+291.348877
+291.954742
+292.366638
+293.018646
+292.235413
+291.197815
+291.245850
+292.060760
+291.700409
+292.009705
+291.380524
+291.887665
+293.516388
+293.173676
+294.155914
+292.904694
+290.639648
+290.504425
+290.455566
+290.461426
+290.252167
+290.206787
+291.040039
+293.486603
+295.629730
+295.930389
+293.695007
+292.646118
+290.613495
+288.961884
+288.729004
+288.534088
+288.774078
+288.247681
+288.968079
+291.082825
+291.615112
+291.103149
+289.200867
+287.585815
+287.166290
+287.788208
+288.495178
+288.501587
+288.824524
+288.635834
+286.540710
+285.533203
+284.795258
+284.687653
+283.631073
+282.980804
+284.976685
+283.621307
+283.666412
+283.308289
+283.103607
+282.852631
+282.647339
+282.528839
+282.525848
+282.606903
+282.719391
+282.884796
+283.180450
+283.580597
+283.965912
+284.281708
+284.503571
+284.740204
+284.965302
+285.206665
+285.498322
+285.824127
+286.234131
+286.742279
+287.145599
+287.141968
+286.614471
+283.214081
+283.047882
+282.816986
+283.266510
+284.043762
+287.484528
+293.373810
+298.784271
+301.579773
+300.162720
+297.202850
+296.650024
+295.827850
+295.259552
+293.820892
+291.422089
+288.046509
+288.180115
+289.294037
+290.844086
+291.814453
+293.035034
+294.496826
+294.790894
+294.447113
+293.850159
+281.295746
+282.192688
+284.430908
+285.836334
+286.317749
+286.177460
+286.244873
+286.700104
+287.183807
+287.567505
+287.970032
+288.294098
+288.523193
+288.646484
+288.708344
+288.723755
+288.692688
+288.630310
+286.791779
+287.790100
+288.411255
+288.998077
+286.777863
+287.117340
+288.398499
+289.636230
+288.865479
+289.363098
+290.411652
+291.583496
+292.026459
+291.744202
+290.529083
+289.409058
+291.041107
+291.921326
+292.247467
+291.949066
+292.108032
+290.896057
+290.645630
+291.331329
+292.173645
+292.831329
+292.525360
+292.419525
+293.168915
+293.452667
+294.328064
+293.976562
+293.697479
+292.150116
+291.322937
+291.176147
+291.295227
+290.611359
+289.838593
+288.981079
+287.841125
+289.391449
+289.819122
+289.898071
+289.732178
+289.521088
+289.119202
+288.760681
+288.904266
+289.418274
+289.327972
+285.406982
+284.363129
+284.086609
+284.081879
+283.702972
+283.418335
+284.885223
+284.710754
+283.645630
+283.191925
+282.762268
+282.419861
+282.194916
+282.066650
+281.982117
+281.977417
+281.987762
+282.057007
+282.292694
+282.706207
+283.236359
+283.770111
+284.142334
+284.417145
+284.645447
+284.908569
+285.242157
+285.613312
+286.015808
+286.346680
+286.325317
+285.926697
+283.421753
+283.069641
+282.845612
+283.497406
+285.073029
+284.874176
+285.878998
+289.425873
+292.465942
+296.132996
+297.852722
+297.915283
+297.945526
+298.086060
+297.760193
+296.726318
+293.549469
+280.805664
+281.837280
+286.450562
+286.436371
+286.889618
+287.213776
+286.292725
+287.934814
+288.938019
+279.075684
+279.819214
+282.094330
+283.445099
+283.463684
+283.470123
+283.692047
+284.080109
+284.483307
+285.147980
+285.897736
+286.523956
+287.009399
+287.293274
+287.465179
+287.564636
+287.601807
+287.533295
+287.411926
+286.533569
+286.748779
+287.360229
+287.981323
+288.485229
+288.680054
+287.301483
+286.770569
+288.632690
+288.843536
+289.614288
+290.603882
+291.741180
+291.221466
+289.682831
+288.624481
+291.023224
+292.252838
+292.389709
+292.711853
+292.103119
+291.473999
+291.092834
+292.294281
+293.489105
+294.230316
+294.544617
+294.377411
+294.561401
+294.526703
+294.161957
+293.370728
+292.325867
+291.090179
+290.270599
+289.726105
+289.311676
+289.222290
+289.260559
+288.951935
+288.106079
+287.260925
+287.517181
+288.265259
+288.999878
+289.554413
+290.021454
+289.631927
+289.333801
+289.777740
+290.704926
+284.280273
+283.878540
+283.557190
+283.232117
+282.859985
+282.726776
+282.861023
+285.685608
+283.456360
+283.297516
+282.782104
+282.281586
+282.048004
+281.922211
+281.824982
+281.792572
+281.791718
+281.769775
+281.902496
+282.288452
+282.828125
+283.336853
+281.639160
+284.247864
+284.495605
+284.894318
+285.347626
+285.718964
+285.929932
+285.815796
+283.624207
+283.178864
+283.142975
+281.798828
+283.280579
+285.267517
+287.360168
+288.213196
+288.009125
+286.955566
+287.233124
+289.172424
+291.141876
+294.225891
+295.449249
+295.816010
+278.877014
+278.096039
+278.594238
+279.668030
+280.460205
+288.878204
+288.350677
+287.700836
+287.204651
+284.363373
+276.345154
+277.527679
+279.968323
+281.416321
+282.293335
+282.031036
+281.672028
+282.354340
+282.816620
+283.282928
+283.945251
+284.780670
+285.363037
+285.696014
+285.996796
+286.228424
+286.389771
+286.519379
+286.563721
+286.462860
+286.323181
+285.534637
+285.782654
+286.342865
+284.147095
+284.883270
+284.478424
+285.121521
+286.229340
+287.395447
+287.722839
+288.539398
+289.551147
+290.036591
+288.306091
+288.407227
+289.097839
+291.289520
+292.510864
+292.952545
+292.634705
+292.362000
+291.782257
+290.941956
+290.670624
+291.066223
+291.409515
+291.263702
+290.676147
+289.801971
+288.553223
+287.832947
+286.298157
+284.994324
+283.817200
+283.088989
+283.026062
+283.272095
+283.399109
+283.801422
+284.664459
+283.669769
+283.479950
+283.557373
+284.402618
+285.979645
+287.684662
+289.117218
+290.126190
+290.506592
+290.440002
+290.370361
+290.220520
+289.042236
+284.780396
+283.235199
+284.146484
+284.505524
+282.315430
+282.795868
+284.328796
+283.745941
+282.761475
+282.081573
+281.721130
+281.551453
+281.498016
+281.533142
+281.507477
+281.424469
+281.637543
+282.335541
+279.907928
+280.498749
+280.484711
+280.159821
+281.442810
+281.422119
+285.395844
+280.177643
+279.818237
+272.036560
+280.127686
+280.359589
+281.075134
+282.287750
+284.189545
+286.508392
+288.399323
+289.305878
+289.206024
+287.911804
+288.410309
+288.850037
+290.311157
+291.941040
+291.877655
+279.124573
+278.809998
+278.604950
+278.402069
+278.506866
+279.138214
+289.673492
+291.432953
+290.380096
+274.998230
+275.103729
+276.737030
+278.986206
+280.523376
+280.281555
+279.104950
+277.844788
+277.587006
+279.831909
+281.992126
+282.615326
+283.170654
+283.740143
+284.258728
+284.677338
+284.989044
+285.206451
+285.339264
+285.403320
+285.357758
+285.243073
+285.203094
+285.357391
+284.737183
+285.285919
+285.688416
+283.617065
+283.901947
+284.428986
+285.237610
+286.125885
+287.972473
+289.369690
+289.590210
+288.237000
+286.961670
+287.253571
+288.760559
+290.579407
+291.443695
+291.904816
+291.534363
+290.556091
+289.064209
+287.397858
+285.934174
+284.865967
+284.200073
+283.637451
+282.926056
+282.175781
+281.568634
+280.672302
+279.640808
+278.470642
+277.488708
+276.943298
+276.997833
+277.381927
+277.779297
+278.125671
+279.160187
+279.911957
+280.105927
+280.003876
+281.988861
+284.235718
+286.576782
+288.527863
+289.300140
+289.067627
+287.968231
+286.471893
+285.134308
+283.441803
+279.746674
+276.872192
+278.688019
+280.075684
+281.145660
+283.345734
+284.917236
+286.324280
+286.661346
+286.234894
+284.715942
+283.830383
+280.775818
+280.883850
+280.757507
+280.612640
+281.115784
+282.403687
+278.213654
+280.326630
+280.154785
+280.675659
+281.616028
+282.119904
+280.760406
+281.250519
+281.204132
+280.990234
+282.673920
+283.120850
+283.900482
+285.434357
+287.262726
+289.395233
+290.641571
+290.449951
+290.490448
+290.469910
+290.833679
+291.400726
+292.106812
+292.852753
+293.167145
+290.929840
+278.080811
+277.704651
+277.530426
+276.030945
+276.591675
+276.533936
+275.966034
+275.413788
+283.996796
+274.667267
+275.666809
+278.410034
+278.982239
+278.126221
+276.791718
+269.863403
+268.858337
+270.736084
+280.338135
+281.660461
+282.681824
+282.971344
+283.072601
+283.349091
+283.619751
+283.787811
+283.857147
+283.746948
+283.533691
+283.481628
+283.731842
+284.173248
+283.688751
+284.223694
+284.600250
+284.830872
+284.865570
+284.239929
+285.526337
+287.121124
+287.425446
+289.457336
+289.938599
+289.282928
+286.555817
+284.387054
+285.367584
+286.790497
+288.640839
+289.577515
+289.443268
+288.836945
+287.771118
+286.345825
+284.843628
+283.404785
+282.201416
+281.276764
+279.154907
+278.650024
+278.872162
+277.894440
+276.654266
+275.247803
+273.978760
+273.000153
+272.566315
+272.784760
+273.077820
+273.506012
+274.437775
+275.178192
+276.101471
+277.364807
+278.969025
+280.875275
+282.923523
+284.487061
+285.174866
+284.524078
+282.946838
+281.140808
+278.894440
+276.176575
+273.472687
+272.490448
+272.766052
+274.027893
+276.121704
+278.885651
+282.430176
+285.458374
+287.089539
+286.565918
+287.236328
+286.689301
+285.002014
+283.662537
+280.345215
+278.857391
+280.247498
+281.757965
+278.047791
+280.060150
+280.083344
+280.514832
+281.578949
+282.520172
+282.430603
+283.550293
+284.551666
+285.308960
+285.938721
+285.749146
+286.000732
+286.840271
+287.878021
+289.031464
+290.899750
+291.942871
+292.876862
+293.176636
+293.302856
+293.547485
+293.703918
+293.507202
+292.490662
+291.755249
+290.724884
+288.368561
+286.046661
+272.548737
+272.625305
+272.857880
+278.842316
+277.999725
+276.970184
+273.359802
+273.227386
+276.533722
+277.525269
+277.711273
+267.149841
+264.276276
+262.784698
+263.186554
+268.674347
+278.361908
+279.198059
+279.715302
+280.170288
+280.565826
+280.669525
+279.267731
+279.148804
+281.307587
+281.225037
+281.460938
+282.158142
+282.979553
+282.240204
+282.721375
+283.119110
+283.453949
+283.715332
+283.831909
+284.525696
+286.813232
+287.879639
+289.172058
+289.097900
+288.516724
+286.893677
+283.315582
+281.149231
+280.721771
+280.425934
+280.354950
+280.229706
+287.434265
+286.913544
+285.462891
+285.257843
+282.916595
+280.659576
+280.320892
+278.195740
+278.417816
+277.413818
+276.997498
+276.766296
+275.425507
+274.022858
+272.975342
+273.460876
+272.319977
+271.549835
+271.569855
+272.068146
+272.710785
+273.409729
+274.276550
+275.154449
+275.975494
+276.716187
+277.198578
+277.449707
+276.876648
+275.997406
+274.822876
+273.187408
+271.477478
+269.552277
+269.177673
+269.275146
+270.656738
+272.395416
+274.655457
+277.642212
+280.589996
+282.447815
+284.113464
+285.019714
+284.542511
+283.340485
+276.055664
+277.366119
+278.087341
+278.992615
+279.813354
+276.721008
+277.585175
+277.375214
+278.542969
+278.241699
+279.071045
+279.918213
+280.547180
+281.056030
+280.959442
+280.781433
+280.628387
+280.501373
+280.546906
+281.280029
+282.609802
+282.665527
+283.443878
+283.698059
+283.831085
+284.340698
+284.265747
+284.005219
+284.154724
+283.762207
+284.462830
+283.270111
+281.965576
+280.669922
+278.513184
+272.496887
+272.628021
+275.908325
+275.033325
+274.969788
+273.201477
+273.274658
+276.177551
+277.204651
+270.631104
+264.436646
+258.455017
+255.816544
+255.436493
+261.729645
+264.632507
+267.855469
+270.997162
+272.951508
+276.972504
+273.710266
+276.041595
+277.703430
+278.839874
+279.273773
+279.952576
+280.810333
+281.626099
+280.216949
+280.663452
+281.139954
+281.507416
+281.906616
+282.169189
+282.044983
+281.709137
+281.584198
+281.542603
+281.436371
+281.205444
+280.809723
+280.310913
+279.959564
+279.730072
+279.508820
+279.267639
+278.951691
+278.574738
+278.067719
+277.329773
+276.501862
+276.135315
+276.341187
+277.135834
+275.673950
+275.487701
+275.065247
+275.148743
+274.786499
+274.375763
+273.533051
+272.091858
+272.367432
+272.380188
+272.174683
+272.236908
+272.587036
+273.178619
+272.468231
+272.338928
+272.366913
+272.344910
+272.300171
+272.344025
+272.529602
+271.960846
+272.106049
+271.434753
+270.815796
+269.765747
+270.904053
+271.076752
+270.596252
+269.575165
+269.906372
+270.420135
+270.993347
+271.639069
+272.295746
+272.596527
+272.429657
+272.177795
+271.767914
+271.182892
+270.742615
+270.604034
+270.811249
+271.808197
+272.850616
+272.873932
+272.858429
+272.834503
+272.867859
+272.926483
+273.047272
+273.105011
+273.119690
+273.035370
+272.877747
+272.698700
+272.563263
+272.483459
+273.604492
+274.638000
+273.375793
+275.342743
+275.439850
+275.498962
+275.727539
+275.303680
+273.061188
+275.698944
+275.788361
+275.482117
+271.949463
+275.268127
+274.058044
+273.240234
+272.791290
+271.514191
+272.797028
+275.252563
+275.276459
+274.384155
+275.357208
+276.268799
+276.968811
+265.696289
+262.326385
+257.855072
+255.296890
+252.147491
+252.953232
+256.956635
+261.638367
+265.078094
+268.167389
+271.389618
+273.861542
+273.160004
+273.160004
+276.169525
+277.746094
+278.645752
+279.184052
+279.705261
+278.039154
+278.584869
+279.159119
+279.617157
+279.910339
+279.924500
+279.565674
+279.063934
+278.878143
+278.948883
+279.064972
+279.138123
+278.847107
+278.304138
+277.968506
+277.865936
+277.850494
+277.755096
+277.486450
+277.180725
+278.671082
+277.404633
+275.843719
+275.573242
+275.554840
+275.609039
+275.729858
+273.631012
+273.479858
+273.139282
+272.884949
+272.983368
+273.661926
+273.419495
+273.039825
+273.103546
+273.179749
+272.896027
+272.634186
+272.196075
+271.390747
+270.197266
+272.271057
+272.860565
+273.858368
+274.348450
+274.853302
+274.837219
+274.203217
+273.936371
+273.567108
+270.862579
+270.774323
+270.608246
+270.513672
+270.400970
+270.157867
+269.543579
+269.149811
+268.693756
+268.821198
+268.989990
+269.261353
+269.653046
+270.379242
+271.329132
+272.402740
+271.838348
+272.146545
+272.861603
+272.880798
+272.829437
+272.836121
+272.818420
+272.764893
+272.683319
+272.550415
+272.453705
+272.373444
+272.341339
+272.338257
+272.336487
+272.311920
+272.224426
+273.224152
+273.308563
+273.080780
+272.001465
+272.044373
+272.149902
+272.187225
+272.029205
+271.639709
+274.132874
+270.146179
+274.175171
+269.346649
+274.315613
+274.654999
+274.267303
+272.741974
+274.416382
+274.731842
+274.996582
+274.661987
+275.066620
+275.517731
+276.180023
+264.799500
+260.009399
+258.191284
+256.258545
+253.799637
+249.704056
+248.135910
+251.185364
+256.387390
+262.733856
+266.038208
+268.558319
+271.113647
+273.262848
+273.160004
+273.160004
+273.160004
+275.783386
+276.847076
+277.442169
+274.315979
+276.040466
+277.468323
+277.956421
+278.123810
+277.876099
+278.324493
+276.778076
+275.282959
+275.359131
+275.527832
+275.747528
+275.658783
+275.214935
+275.103058
+275.361938
+275.679443
+275.725128
+275.617920
+275.559448
+275.515869
+274.983154
+274.023132
+273.061707
+272.701721
+272.378937
+272.396088
+272.361511
+272.121002
+269.743958
+270.946259
+271.461761
+271.902924
+271.938385
+271.863281
+271.728851
+272.423676
+272.328857
+271.852661
+271.462738
+270.531281
+270.391083
+270.218658
+269.991028
+269.766144
+269.433044
+269.094299
+269.118835
+269.290833
+271.382965
+269.774231
+269.934052
+270.094147
+270.339355
+270.690765
+270.787140
+270.638855
+270.437897
+270.225403
+270.286011
+270.460815
+271.251251
+271.857697
+272.196381
+272.573975
+272.875183
+273.076843
+273.148865
+273.153290
+273.151276
+273.079346
+272.962372
+272.850281
+272.665710
+272.463623
+272.282990
+272.146576
+272.040558
+271.966400
+271.867615
+271.737488
+271.629791
+271.589142
+271.603607
+271.518494
+271.346649
+271.156281
+271.867126
+270.971954
+271.886108
+270.702209
+270.627838
+270.403473
+272.796844
+273.185760
+273.437592
+273.411621
+273.180054
+271.949127
+271.121124
+273.887085
+273.884369
+274.073669
+273.046143
+268.846649
+267.447021
+266.081024
+262.998810
+258.428864
+256.790771
+254.743103
+251.862961
+248.482697
+245.968689
+245.964249
+248.300507
+251.218216
+257.772980
+264.981812
+268.133484
+270.124542
+272.009338
+272.524567
+273.056274
+273.160004
+273.160004
+273.160004
+273.160004
+272.515106
+272.538910
+272.617493
+272.660431
+272.678772
+272.691162
+272.819214
+274.043060
+274.012238
+273.141235
+273.111877
+273.084381
+273.092804
+273.090546
+273.129883
+273.110474
+273.001617
+272.898895
+272.699463
+272.475250
+272.018005
+271.310883
+270.301239
+268.845764
+266.873291
+266.021576
+266.085632
+266.233246
+266.405640
+266.786560
+267.358612
+267.838715
+268.463226
+269.070129
+269.575287
+269.388885
+269.661407
+269.916626
+269.793457
+269.503723
+269.204376
+268.936523
+268.860168
+268.709961
+268.580322
+268.581757
+268.614655
+268.552612
+268.504486
+268.717133
+268.613953
+268.580170
+268.685486
+268.836395
+268.991455
+269.163574
+269.340210
+269.578674
+269.826202
+270.054291
+270.239075
+270.416290
+270.549927
+270.700012
+270.833649
+270.931885
+271.016937
+271.059784
+270.968689
+270.800354
+270.516602
+269.985443
+269.436615
+268.954010
+268.625427
+268.393585
+268.106873
+267.878906
+267.749756
+267.721008
+267.772797
+267.921448
+268.158295
+268.402313
+268.550537
+268.658905
+268.706726
+268.731750
+268.755554
+268.829071
+268.936005
+269.066864
+269.228516
+269.376312
+270.570587
+270.000854
+269.390900
+268.719604
+268.009583
+266.747009
+259.411224
+258.847107
+265.733734
+267.014282
+272.066895
+259.051941
+255.327560
+255.465134
+254.452377
+253.838074
+253.049667
+251.834518
+250.848831
+250.031586
+249.872620
+251.120132
+253.707199
+257.204590
+262.515076
+268.323853
+270.448242
+271.562775
+271.861420
+272.159607
+272.390808
+272.598969
+272.809082
+272.916901
+273.006805
+273.024811
+272.965057
+272.955872
+272.901886
+272.647552
+272.739227
+272.765259
+272.779633
+272.670349
+272.505676
+272.329437
+272.013428
+271.722076
+271.546295
+271.287018
+271.000671
+270.696045
+270.350555
+269.909515
+269.317200
+268.497894
+267.461426
+266.589539
+266.018036
+265.668945
+265.411194
+265.199554
+265.182709
+265.301422
+265.490265
+265.724274
+266.055878
+266.427887
+267.129089
+267.936890
+268.668762
+269.182281
+269.876038
+270.670166
+270.844208
+271.045349
+270.980164
+270.827881
+270.675842
+270.533264
+270.401947
+270.281006
+270.165741
+270.056396
+269.974701
+269.913605
+269.764679
+268.978210
+267.489990
+266.824677
+265.655792
+265.206177
+265.117554
+265.093445
+265.384918
+265.941223
+266.335297
+266.520172
+266.523773
+266.430298
+266.311829
+266.166779
+266.028290
+265.859619
+265.732605
+265.598480
+265.397980
+265.188354
+265.060730
+265.082520
+265.246826
+265.392609
+265.504211
+265.649658
+265.869019
+266.121185
+266.347473
+266.557953
+266.777985
+267.141174
+267.922394
+268.623871
+269.416595
+270.117462
+270.460632
+270.604523
+270.626038
+270.586029
+270.554321
+270.605072
+270.897797
+270.806641
+270.679626
+269.667542
+268.787201
+268.285431
+267.963287
+267.677979
+267.422699
+267.336365
+266.865265
+266.589355
+266.347504
+266.137726
+264.177368
+262.639130
+261.067261
+261.915771
+261.225983
+259.934723
+259.434235
+261.237000
+264.277039
+267.839355
+270.397491
+270.681824
+271.313049
+271.869110
+272.258057
+272.537476
+272.772614
+272.915649
+272.630951
+272.452972
+272.327606
+272.134186
+272.021606
+271.924225
+271.841705
+271.746307
+271.617859
+271.437775
+271.271545
+271.083832
+270.872406
+270.692871
+270.521881
+270.338348
+270.143646
+269.937042
+269.705017
+269.433960
+269.108490
+268.706482
+268.249878
+267.821686
+267.410828
+267.058868
+266.787811
+266.613831
+266.514099
+266.468842
+266.467743
+266.827301
+267.515137
+268.799683
+269.790314
+271.181885
+271.801514
+272.356506
+272.584961
+272.656281
+272.695587
+272.717926
+272.721375
+272.710815
+272.681854
+272.642883
+272.598602
+272.548309
+272.481354
+272.397095
+272.280701
+272.042236
+271.515900
+270.179199
+268.577240
+268.098663
+267.992035
+268.031433
+267.947296
+267.936035
+267.907562
+267.928711
+267.874725
+267.860565
+267.999725
+268.316040
+268.576904
+268.648102
+268.702881
+268.727905
+268.912262
+269.044617
+269.256561
+269.321411
+269.381561
+269.420685
+269.525116
+269.754272
+269.957825
+270.261780
+270.537781
+270.841003
+271.272034
+271.702484
+272.089661
+272.397888
+272.519928
+272.582703
+272.595520
+272.539429
+272.450256
+272.349091
+272.245850
+272.144348
+272.050354
+271.957184
+271.839325
+271.720734
+271.662537
+271.610321
+271.512329
+271.369904
+271.299072
+271.211426
+271.063629
+270.876770
+270.705383
+270.365082
+270.354797
+270.425934
+270.507050
+270.636841
+270.814575
+271.046600
+271.274689
+271.479889
+271.647766
+271.832977
+271.966858
+272.099579
+272.244080
+272.356567
+272.449524
+272.522644
+272.576599
+272.709167
+272.771149
+272.748962
+270.299133
+270.284485
+270.265839
+270.243866
+270.216736
+270.182800
+270.144928
+270.103485
+270.056671
+270.004364
+269.948120
+269.885956
+269.817047
+269.728088
+269.631226
+269.549683
+269.471008
+269.382660
+269.308655
+269.233307
+269.111145
+268.972717
+268.886963
+268.812866
+268.751740
+268.696014
+268.654663
+268.611206
+268.575897
+268.547058
+268.517487
+268.492401
+268.476654
+268.463959
+268.436737
+268.471680
+268.477600
+268.498291
+268.510345
+268.539825
+268.574036
+268.598785
+268.644409
+268.695435
+268.743225
+268.799744
+268.858154
+268.899445
+268.937866
+268.976562
+269.036255
+269.084869
+269.151337
+269.184143
+269.214539
+269.228210
+269.258606
+269.246552
+269.243011
+269.233185
+269.220795
+269.156250
+269.172089
+269.167297
+269.157379
+269.179779
+269.208130
+269.231079
+269.248688
+269.291931
+269.372620
+269.427155
+269.498596
+269.551178
+269.611023
+269.677307
+269.729370
+269.754578
+269.798462
+269.841583
+269.882172
+269.897278
+269.920227
+269.939758
+269.961273
+269.986816
+270.036224
+270.109283
+270.154083
+270.298187
+270.337616
+270.443970
+270.510345
+270.540314
+270.619202
+270.677979
+270.613495
+270.584045
+270.471680
+270.441010
+270.392487
+270.276031
+270.250977
+270.208801
+270.130859
+270.083374
+270.041534
+270.046814
+270.027893
+270.041870
+270.011993
+270.018951
+270.033447
+270.072815
+270.109467
+270.124359
+270.133179
+270.185852
+270.210388
+270.235107
+270.241913
+270.250580
+270.257477
+270.277802
+270.307007
+270.311890
+270.308350
+270.308655
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/coupler.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/coupler.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/coupler.F90	(revision 4775)
@@ -0,0 +1,214 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS coupler.F90,v 1.6 2006-10-17 21:46:35 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE: coupler -- coupler for sequential model example
+!
+! !DESCRIPTION:
+! A coupler subroutine for sequential climate model example.
+!
+! !INTERFACE:
+!
+module coupler
+!
+! !USES:
+!
+! Get the things needed from MCT by "Use,only" with renaming:
+!
+!---Domain Decomposition Descriptor DataType and associated methods
+use m_GlobalSegMap,only: GlobalSegMap
+
+!---Field Storage DataType and associated methods
+use m_AttrVect,only    : AttrVect
+
+!---Sparse Matrix DataType and associated methods
+use m_SparseMatrix, only : SparseMatrix
+use m_SparseMatrix, only : SparseMatrix_clean => clean
+use m_SparseMatrix, only : SparseMatrix_init => init
+use m_SparseMatrix, only : SparseMatrix_importGRowInd => &
+                              importGlobalRowIndices
+use m_SparseMatrix, only : SparseMatrix_importGColInd => &
+                                    importGlobalColumnIndices
+use m_SparseMatrix, only : SparseMatrix_importMatrixElts => &
+                                   importMatrixElements
+use m_SparseMatrixPlus, only : SparseMatrixPlus
+use m_SparseMatrixPlus, only : SparseMatrixPlus_init => init
+use m_SparseMatrixPlus, only : SparseMatrixPlus_clean => clean
+use m_SparseMatrixPlus, only : Xonly ! Decompose matrix by row
+!---Matrix-Vector multiply methods
+use m_MatAttrVectMul, only: MCT_MatVecMul => sMatAvMult
+
+!---MPEU I/O utilities
+use m_stdio
+use m_ioutil
+
+implicit none
+
+private
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+public cplinit
+public cplrun
+public cplfin
+
+! !PRIVATE DATA MEMBERS
+type(SparseMatrixPlus) :: Src2DstMatPlus   ! the mapping weights
+
+character(len=*), parameter :: cplname='coupler.F90'
+integer :: rank
+
+!EOP ___________________________________________________________________
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cplinit - initialize the coupler
+!
+! !INTERFACE:
+
+subroutine cplinit(SrcGSMap,DstGSMap,comm,compid)
+
+! !INPUT PARAMETERS:
+
+  type(GlobalSegMap),intent(in) :: SrcGSMap,DstGSMap  ! GSmaps for source and dst
+  integer,intent(in) :: comm    !  local MPI communicator
+  integer,intent(in) :: compid  ! coupler's component ID
+!
+!EOP ___________________________________________________________________
+
+!     Local variables
+  character(len=100),parameter :: &
+        RemapMatrixFile='../../data/t42_to_popx1_c_mat.asc'
+
+! Loop indicies
+  integer :: i,j,k,n
+
+! MPI variables
+  integer :: nprocs, root, ierr
+! SparseMatrix variables
+  integer :: mdev
+  integer :: num_elements, nRows, nColumns
+  integer, dimension(2) :: src_dims, dst_dims
+  integer, dimension(:), pointer :: rows, columns
+  real, dimension(:), pointer :: weights
+! SparseMatrix elements on root
+  type(SparseMatrix) :: sMat
+! _____________________________________________________________________
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   INITIALIZATION PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      
+  ! LOCAL RANK AND SIZE
+  call MPI_COMM_RANK(comm,rank,ierr)
+  call MPI_COMM_SIZE(comm,nprocs,ierr)
+  root = 0
+
+  if(rank==0) write(6,*) cplname,' init start'
+  if(rank==0) write(6,*) cplname,' MyID ', compid
+  if(rank==0) write(6,*) cplname,' Num procs ', nprocs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ! Read matrix weights for interpolation from a file.
+  if (rank == root) then
+     mdev = luavail()
+     open(mdev, file=trim(RemapMatrixFile), status="old")
+     read(mdev,*) num_elements
+     read(mdev,*) src_dims(1), src_dims(2)
+     read(mdev,*) dst_dims(1), dst_dims(2)
+     
+     allocate(rows(num_elements), columns(num_elements), &
+          weights(num_elements), stat=ierr)
+
+     do n=1, num_elements
+        read(mdev,*) rows(n), columns(n), weights(n)
+     end do
+     
+     close(mdev)
+
+     ! Initialize a Sparsematrix
+     nRows = dst_dims(1) * dst_dims(2)
+     nColumns = src_dims(1) * src_dims(2)     
+     call SparseMatrix_init(sMat,nRows,nColumns,num_elements)
+     call SparseMatrix_importGRowInd(sMat, rows, size(rows))
+     call SparseMatrix_importGColInd(sMat, columns, size(columns))
+     call SparseMatrix_importMatrixElts(sMat, weights, size(weights))
+
+     deallocate(rows, columns, weights, stat=ierr)
+
+  endif
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ! Build a SparseMatrixPlus for doing the interpolation
+  ! Specify matrix decomposition to be by row.
+  ! following the atmosphere's decomposition.
+  call SparseMatrixPlus_init(Src2DstMatPlus, sMat, SrcGSMap, DstGSMap, &
+       Xonly, root, comm, compid)
+
+  ! no longer need the matrix defined on root
+  if(rank==0) call SparseMatrix_clean(sMat)
+  if(rank==0) write(6,*) cplname, ' init done'
+
+
+!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+end subroutine cplinit
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   RUN PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cplrun - coupler's run method
+
+subroutine cplrun(IMPORT,EXPORT)
+
+! !INPUT PARAMETERS:
+  type(AttrVect),intent(in) :: IMPORT
+  type(AttrVect),intent(out) :: EXPORT
+!EOP -------------------------------------------------------------------
+
+  if(rank==0) write(6,*) cplname, ' run start'
+
+  ! Interpolate by doing a parallel sparsematrix-attrvect multiply
+  ! Note:  this will interpolate all fields with the same names
+
+  call MCT_MatVecMul(IMPORT, Src2DstMatPlus, EXPORT)
+
+  ! possibly do more calculations
+
+  if(rank==0) write(6,*) cplname, ' run done'
+!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+end subroutine cplrun
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   FINALIZE PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cplfin - coupler's finalize method
+
+subroutine cplfin
+
+!
+!EOP -------------------------------------------------------------------
+
+      call SparseMatrixPlus_clean(Src2DstMatPlus)
+      if(rank==0) write(6,*) cplname, " done"
+end subroutine cplfin
+
+end module coupler
+         
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dst.rc
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dst.rc	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dst.rc	(revision 4775)
@@ -0,0 +1,6 @@
+# Resource file for dst model
+# nx and ny::  global grid size in x and y
+
+  nx: 320
+  ny: 384
+  decomp: R
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dstmodel.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dstmodel.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/dstmodel.F90	(revision 4775)
@@ -0,0 +1,231 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS dstmodel.F90,v 1.8 2006-10-17 21:47:56 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: dstmodel -- generic model for sequential climate model
+!
+! !DESCRIPTION:
+! init run and finalize methods for destination model
+!
+! !INTERFACE:
+!
+module dstmodel
+
+!
+! !USES:
+!
+! Get the things needed from MCT by "Use,only" with renaming:
+!
+!---Domain Decomposition Descriptor DataType and associated methods
+use m_GlobalSegMap,only: GlobalSegMap
+use m_GlobalSegMap,only: GlobalSegMap_init => init
+use m_GlobalSegMap,only: GlobalSegMap_lsize => lsize
+use m_GlobalSegMap,only: GlobalSegMap_clean => clean
+!---Field Storage DataType and associated methods
+use m_AttrVect,only    : AttrVect
+use m_AttrVect,only    : AttrVect_init => init
+use m_AttrVect,only    : AttrVect_lsize => lsize
+use m_AttrVect,only    : AttrVect_clean => clean
+use m_AttrVect,only    : AttrVect_copy => copy
+use m_AttrVect,only    : AttrVect_indxR => indexRA
+use m_AttrVect,only    : AttrVect_importRAttr => importRAttr
+use m_AttrVectcomms,only  : AttrVect_gather => gather
+
+! Get things from MPEU
+use m_inpak90   ! Resource files
+use m_stdio     ! I/O utils
+use m_ioutil
+
+
+! Get utilities for this program.
+use mutils
+
+implicit none
+
+private
+! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+public dstinit
+public dstrun
+public dstfin
+
+! module variables
+character(len=*), parameter :: modelname='dstmodel.F90'
+integer  :: rank, lcomm
+
+!EOP -------------------------------------------------------------------
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dstinit  - Destination model initialization
+
+subroutine dstinit(GSMap,IMPORT,EXPORT,comm,compid)
+
+! !INPUT PARAMETERS:
+  type(GlobalSegMap),intent(inout) :: GSMap    ! decomposition
+  type(AttrVect),intent(inout)     :: IMPORT,EXPORT  ! state data
+  integer,intent(in)               :: comm     ! MPI communicator 
+  integer,intent(in)               :: compid   ! component ID
+!
+!EOP ___________________________________________________________________
+
+!     local variables
+
+!     parameters for this model
+  integer :: nxa   ! number of points in x-direction
+  integer :: nya   ! number of points in y-direction
+
+  integer :: i,j,k,idx
+
+  integer :: nprocs, root, ier
+
+! GlobalSegMap variables
+  integer,dimension(:),pointer :: lindex
+
+! AttrVect variables
+  integer :: avsize
+
+  character*2, ldecomp
+
+
+  call MPI_COMM_RANK(comm,rank, ier)
+  call MPI_COMM_SIZE(comm,nprocs,ier)
+
+! save local communicator
+  lcomm=comm
+
+  if(rank==0) then
+    write(6,*) modelname, ' init start'
+    write(6,*) modelname,' MyID ', compid
+    write(6,*) modelname,' Num procs ', nprocs
+  endif
+
+!  Get configuration
+  call i90_LoadF('dst.rc',ier)
+
+  call i90_label('nx:',ier)
+  nxa=i90_gint(ier)
+  call i90_label('ny:',ier)
+  nya=i90_gint(ier)
+  if(rank==0) write(6,*) modelname, ' x,y ', nxa,nya
+
+  call i90_label('decomp:',ier)
+  call i90_Gtoken(ldecomp, ier)
+  if(rank==0) write(6,*) modelname, ' decomp ', ldecomp
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Initialize a Global Segment Map
+
+
+  call get_index(ldecomp,nprocs,rank,nxa,nya,lindex)
+
+  call GlobalSegMap_init(GSMap,lindex,comm,compid,gsize=nxa*nya)
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+  if(rank==0) write(6,*) modelname, ' GSMap ',GSMap%ngseg,GSMap%gsize
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Initialize import and export Attribute vectors
+
+! size is the number of grid points on this processor
+  avsize = GlobalSegMap_lsize(GSMap,comm)
+  if(rank==0) write(6,*) modelname, ' localsize ', avsize
+
+! initialize Avs with two real attributes.
+  call AttrVect_init(IMPORT,rList="field3:field4",lsize=avsize)
+  call AttrVect_init(EXPORT,rList="field5:field6",lsize=avsize)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  if(rank==0) write(6,*) modelname, ' init done'
+end subroutine dstinit
+!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   RUN PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dstrun  - Destination model run method
+
+subroutine dstrun(IMPORT,EXPORT)
+
+! !INPUT PARAMETERS:
+  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! Input and Output states
+
+!EOP -------------------------------------------------------------------
+
+! local variables
+  integer :: avsize,ier,i,index
+     
+  if(rank==0) write(6,*) modelname, ' run start'
+
+! Copy input data to output data using translation between different names
+  call AttrVect_copy(IMPORT,EXPORT,rList="field3:field4", &
+                                     TrList="field5:field6")
+
+  if(rank==0) write(6,*) modelname, ' run done'
+
+end subroutine dstrun
+!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   FINALIZE PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dstfin  - Destination model finalize method
+
+subroutine dstfin(IMPORT,EXPORT,GSMap)
+
+! !INPUT PARAMETERS:
+  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! MCT defined type
+  type(GlobalSegMap),intent(inout) :: GSMap
+
+!EOP -------------------------------------------------------------------
+  type(AttrVect) :: GlobalD
+  integer :: lsize,ier,mdev,i
+
+  if(rank==0) write(6,*) modelname,' fin start'
+! gather data to node 0 and write it out
+  call AttrVect_gather(EXPORT,GlobalD,GSMap,0,lcomm,ier)
+
+! write out gathered data
+  if(rank==0) then
+    mdev=luavail()
+    lsize=AttrVect_lsize(GlobalD)
+    open(mdev, file="TS1out.dat")
+    do i=1,lsize
+     write(mdev,*) GlobalD%rAttr(1,i) 
+    enddo
+    close(mdev)
+  endif
+
+ ! clean up
+  call AttrVect_clean(IMPORT)
+  call AttrVect_clean(EXPORT)
+  if(rank==0)call AttrVect_clean(GlobalD)
+  call GlobalSegMap_clean(GSMap)
+  if(rank==0) write(6,*) modelname,' fin done'
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+endsubroutine dstfin
+
+end module dstmodel
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/master.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/master.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/master.F90	(revision 4775)
@@ -0,0 +1,103 @@
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS master.F90,v 1.5 2009-02-23 23:22:47 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !PROGRAM: master  -- driver for sequential coupled model example
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect to 
+!  components executing sequentially in a single executable. 
+!
+program master
+
+!
+! !USES:
+!
+
+  use m_AttrVect,only    : AttrVect
+  use m_GlobalSegMap,only: GlobalSegMap
+  use m_MCTWorld,only: MCTWorld_init => init
+
+  use srcmodel
+  use dstmodel
+  use coupler
+
+  implicit none
+
+  include "mpif.h"
+
+!
+!EOP -------------------------------------------------------------------
+
+!     local variables
+
+  character(len=*), parameter :: mastername='master.F90'
+
+  integer :: ncomps = 3   ! Must know total number of 
+                         ! components in coupled system
+
+  integer,dimension(:),pointer :: comps  ! array with component ids
+
+
+  type(AttrVect) :: srcImp,srcExp   ! import and export states for src and
+  type(AttrVect) :: dstImp,dstExp   ! destination models
+
+  type(GlobalSegMap) :: srcGSMap    ! decomposition descriptors for src and
+  type(GlobalSegMap) :: dstGSMap    ! desitnation models
+
+! other variables
+  integer :: comm1, comm2, rank, nprocs,compid, myID, ier,color
+  integer :: anprocs,cnprocs
+
+!-----------------------------------------------------------------------
+! The Main program. 
+! We are implementing a single-executable, sequential-execution system.
+!
+! This main program initializes MCT  and runs the whole model.
+
+! Initialize MPI
+  call MPI_INIT(ier)
+
+! Get basic MPI information
+  call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ier)
+  call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ier)
+
+! Get communicators for each model
+  call mpi_comm_dup(MPI_COMM_WORLD,comm1,ier)
+  call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
+
+! Initialize MCT
+  allocate(comps(ncomps),stat=ier)
+  comps(1)=1
+  comps(2)=2
+  comps(3)=3
+  call MCTWorld_init(ncomps,MPI_COMM_WORLD,comm1,myids=comps)
+
+
+! Initialize the model
+  call srcinit(srcGSMap,srcImp,srcExp,comm1,1)
+  call dstinit(dstGSMap,dstImp,dstExp,comm2,2)
+  call cplinit(srcGSMap,dstGSMap,comm1,3)
+
+! Run the model
+
+! source does something with srcImp and produces export
+  call srcrun(srcImp,srcExp)
+
+! map the source model's Export to the destination model's Import
+  call cplrun(srcExp,dstImp)
+
+! destination model does something with dstImp
+  call dstrun(dstImp,dstExp)
+
+! Finalize
+  call srcfin(srcImp,srcExp,srcGSMap)
+  call dstfin(dstImp,dstExp,dstGSMap)
+  call cplfin
+
+  call MPI_FINALIZE(ier)
+
+end program master
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/mutils.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/mutils.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/mutils.F90	(revision 4775)
@@ -0,0 +1,139 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS mutils.F90,v 1.8 2005-11-18 23:15:38 rloy Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: mutils -- utilities for the sequential climate example
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+!
+module mutils
+
+! module of utilties for the sequential climate example
+!
+
+  implicit none
+
+  private
+! except
+
+! !PUBLIC TYPES:
+
+  public get_index
+
+  contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: get_index - get local index array and size
+! for 3 standard decompositions of a grid.
+!
+! !DESCRIPTION:
+! The routine get_index will return a local index array and size that can
+! be passed to a GSMap_init routine for three possible decompositions:
+! R - by row or latitude
+! C - by column or longitude
+! RC - row and column or checkerboard
+! choice is determined by the value of ldecomp.
+!
+! !INTERFACE:
+
+subroutine get_index(ldecomp,nprocs,myproc,gnx,gny,gridbuf)
+! !INPUT PARAMETERS:
+!
+  character(len=*),intent(inout) :: ldecomp   !  decomp choice
+  integer,intent(in)             :: nprocs    ! total number of MPI processes
+  integer,intent(in)             :: myproc    ! my rank in local communicator
+  integer,intent(in)             :: gnx       ! total points in X direction
+  integer,intent(in)             :: gny       ! total points in Y direction
+
+! !OUTPUT PARAMETERS:
+!
+  integer,dimension(:),pointer :: gridbuf  ! local index array
+!
+!EOP ___________________________________________________________________
+
+  integer :: npesx,npesy,ng,ny,n,i,j,nx,ig,jg,nseg,factor
+
+
+! default decomp is R
+   if((trim(ldecomp) .ne. 'R') .and. (ldecomp .ne. 'C') .and. (ldecomp .ne. 'RC')) then
+      ldecomp = 'R'
+   endif
+  
+! A 'by-row' or 'by-latitude' decomposition
+  if(trim(ldecomp) .eq. 'R') then
+   npesx=1
+   npesy=nprocs
+   nx=gnx
+   ny=gny/npesy
+   allocate(gridbuf(nx*ny))
+   n=0
+   do j=1,ny
+     do i=1,nx
+      n=n+1
+      ig=i
+      jg = j + myProc*ny
+      ng =(jg-1)*gnx + ig
+      gridbuf(n)=ng
+     enddo
+   enddo
+
+! A 'by-column' or 'by-longitude' decomposition
+  else if (ldecomp .eq. 'C') then
+   npesx=nprocs
+   npesy=1
+   nx=gnx/npesx
+   ny=gny
+   allocate(gridbuf(nx*ny))
+   n=0
+   do j=1,ny
+    do i=1,nx
+      n=n+1
+      ig=i + myProc*nx
+      jg= j
+      ng=(jg-1)*gnx + ig
+      gridbuf(n)=ng
+    enddo
+   enddo
+
+! A 'row-columen' or 'checkerboard' decomposition
+  else if (ldecomp .eq. 'RC') then
+  ! find the closest square
+   factor=1
+   do i=2,INT(sqrt(FLOAT(nprocs)))
+     if ( (nprocs/i) * i .eq. nprocs) then
+       factor = i
+     endif
+   enddo
+   npesx=factor
+   npesy=nprocs/factor
+   nx=gnx/npesx
+   ny=gny/npesy
+!   write(6,*) 'RC',factor,npesy,nx,ny
+   allocate(gridbuf(nx*ny))
+   n=0
+   do j=1,ny
+     do i=1,nx
+       n=n+1
+       ig=mod(myProc,npesx)*nx+i
+       jg=(myProc/npesx)*ny+j
+       ng=(jg-1)*gnx + ig
+       gridbuf(n)=ng
+     enddo
+   enddo
+
+   
+  endif
+
+end subroutine get_index
+
+
+
+
+end module mutils
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/src.rc
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/src.rc	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/src.rc	(revision 4775)
@@ -0,0 +1,6 @@
+# Resource file for src model
+# nx and ny::  global grid size in x and y
+
+  nx: 128
+  ny: 64
+  decomp: R
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/srcmodel.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/srcmodel.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/climate_sequen1/srcmodel.F90	(revision 4775)
@@ -0,0 +1,248 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS srcmodel.F90,v 1.8 2005-11-18 23:15:38 rloy Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: srcmodel -- generic model for unit tester
+!
+! !DESCRIPTION:
+! init run and finalize methods for source model
+!
+module srcmodel
+
+!
+! !USES:
+!
+! Get the things needed from MCT by "Use,only" with renaming:
+!
+!---Domain Decomposition Descriptor DataType and associated methods
+use m_GlobalSegMap,only: GlobalSegMap
+use m_GlobalSegMap,only: GlobalSegMap_init => init
+use m_GlobalSegMap,only: GlobalSegMap_lsize => lsize
+use m_GlobalSegMap,only: GlobalSegMap_clean => clean
+!---Field Storage DataType and associated methods
+use m_AttrVect,only    : AttrVect
+use m_AttrVect,only    : AttrVect_init => init
+use m_AttrVect,only    : AttrVect_lsize => lsize
+use m_AttrVect,only    : AttrVect_clean => clean
+use m_AttrVect,only    : AttrVect_copy => copy
+use m_AttrVect,only    : AttrVect_zero => zero
+use m_AttrVect,only    : AttrVect_indxR => indexRA
+use m_AttrVect,only    : AttrVect_importRAttr => importRAttr
+use m_AttrVectComms,only : AttrVect_scatter => scatter
+
+! Get things from MPEU
+use m_inpak90   ! Resource files
+use m_stdio     ! I/O utils
+use m_ioutil
+
+! Get utilities for this program.
+use mutils
+
+implicit none
+
+private
+! except
+      
+! !PUBLIC MEMBER FUNCTIONS:
+
+public srcinit
+public srcrun
+public srcfin
+
+! private module variables
+character(len=*), parameter :: modelname='srcmodel.F90'
+integer  :: rank
+real, dimension(:), pointer :: avdata
+
+!EOP -------------------------------------------------------------------
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: srcinit  - Source model initialization
+
+subroutine srcinit(GSMap,IMPORT,EXPORT,comm,compid)
+
+! !INPUT PARAMETERS:
+  type(GlobalSegMap),intent(inout) :: GSMap    !  decomposition
+  type(AttrVect),intent(inout)     :: IMPORT,EXPORT  !  state data
+  integer,intent(in)               :: comm     !  MPI communicator
+  integer,intent(in)               :: compid   !  component ID
+!
+!EOP ___________________________________________________________________
+
+!     local variables
+
+!     parameters for this model
+  integer :: nxa   ! number of points in x-direction
+  integer :: nya   ! number of points in y-direction
+
+  integer :: i,j,k,mdev,fx,fy
+  integer :: nprocs, root, ier,fileno
+
+! GlobalSegMap variables
+  integer,dimension(:),pointer :: lindex
+
+! AttrVect variables
+  integer :: avsize
+  type(AttrVect)   :: GlobalD  ! Av to hold global data
+
+  real,dimension(:),pointer :: rootdata
+
+  character*2 :: ldecomp
+
+
+  call MPI_COMM_RANK(comm,rank, ier)
+  call MPI_COMM_SIZE(comm,nprocs,ier)
+
+  if(rank==0) then
+    write(6,*) modelname, ' init start'
+    write(6,*) modelname,' MyID ', compid
+    write(6,*) modelname,' Num procs ', nprocs
+  endif
+
+!  Get configuration
+   call i90_LoadF('src.rc',ier)
+
+   call i90_label('nx:',ier)
+   nxa=i90_gint(ier)
+   call i90_label('ny:',ier)
+   nya=i90_gint(ier)
+  if(rank==0) write(6,*) modelname, ' x,y ', nxa,nya
+
+   call i90_label('decomp:',ier)
+   call i90_Gtoken(ldecomp, ier)
+  if(rank==0) write(6,*) modelname, ' decomp ', ldecomp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Initialize a Global Segment Map
+
+
+  call get_index(ldecomp,nprocs,rank,nxa,nya,lindex)
+
+  call GlobalSegMap_init(GSMap,lindex,comm,compid,gsize=nxa*nya)
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  if(rank==0) write(6,*) modelname, ' GSMap ',GSMap%ngseg,GSMap%gsize
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Initialize import and export Attribute vectors
+
+! size is the number of grid points on this processor
+  avsize = GlobalSegMap_lsize(GSMap,comm)
+  if(rank==0) write(6,*) modelname, ' localsize ', avsize
+
+! Initialize the IMPORT  Av by scattering from a root Av
+! with real data.
+
+! Read in data from root and scatter to nodes
+  if(rank==0) then
+    call AttrVect_init(GlobalD,rList="field1:field2",lsize=nxa*nya)
+    mdev=luavail()
+    open(mdev, file="TS1.dat",status="old")
+    read(mdev,*) fx,fy
+    do i=1,nxa*nya
+      read(mdev,*) GlobalD%rAttr(1,i)
+    enddo
+    write(6,*) modelname,'Global init ',GlobalD%rAttr(1,1),GlobalD%rAttr(1,8000)
+  endif
+
+! this scatter will create IMPORT if it hasn't already been initialized
+  call AttrVect_scatter(GlobalD,IMPORT,GSMap,0,comm,ier)
+
+! initialize EXPORT Av with two real attributes.
+  call AttrVect_init(EXPORT,rList="field3:field4",lsize=avsize)
+  
+  call AttrVect_zero(EXPORT)
+
+  if(rank==0) then
+    write(6,*) modelname, rank,' IMPORT field1', IMPORT%rAttr(1,1)
+    write(6,*) modelname, rank,' IMPORt field2', IMPORT%rAttr(2,1)
+    write(6,*) modelname, rank,' EXPORT field3', EXPORT%rAttr(1,1)
+    write(6,*) modelname, rank,' EXPORT field4', EXPORT%rAttr(2,1)
+  endif
+
+! allocate buffer for use in run method
+  allocate(avdata(avsize),stat=ier)
+
+  if(rank==0) write(6,*) modelname, ' init done'
+end subroutine srcinit
+!!! END OF INIT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   RUN PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: srcrun  - Source model run method
+
+subroutine srcrun(IMPORT,EXPORT)
+
+! !INPUT PARAMETERS:
+  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! Input and Output states
+
+!EOP -------------------------------------------------------------------
+! local variables
+  integer :: avsize,ier,i
+     
+! Nothing to do with IMPORT
+
+
+! Fill EXPORT with data
+  if(rank==0) write(6,*) modelname, ' run start'
+
+! Use Av copy to copy input data from field1 in Imp to field3 in EXPORT
+  call AttrVect_copy(IMPORT,EXPORT,rList='field1',TrList='field3')
+
+! Use import to load data in second field
+  avdata=30.0
+  call AttrVect_importRAttr(EXPORT,"field4",avdata)
+
+  if(rank==0) write(6,*) modelname, ' In field1', IMPORT%rAttr(1,1)
+  if(rank==0) write(6,*) modelname, ' In field2', IMPORT%rAttr(2,1)
+  if(rank==0) write(6,*) modelname, ' Out field3', EXPORT%rAttr(1,1)
+  if(rank==0) write(6,*) modelname, ' Out field4', EXPORT%rAttr(2,1)
+
+  if(rank==0) write(6,*) modelname, ' run done'
+
+end subroutine srcrun
+!!! END OF RUN  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!   FINALIZE PHASE
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: srcfin  - Source model finalize method
+
+subroutine srcfin(IMPORT,EXPORT,GSMap)
+
+! !INPUT PARAMETERS:
+  type(AttrVect),intent(inout) :: IMPORT,EXPORT   ! imp,exp states
+  type(GlobalSegMap),intent(inout) :: GSMap
+!EOP -------------------------------------------------------------------
+ ! clean up
+  call AttrVect_clean(IMPORT)
+  call AttrVect_clean(EXPORT)
+  call GlobalSegMap_clean(GSMap)
+  deallocate(avdata)
+  if(rank==0) write(6,*) modelname,' fin done'
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+endsubroutine srcfin
+
+end module srcmodel
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+twocon twoseq twosequn twoseqNB
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/Makefile	(revision 4775)
@@ -0,0 +1,53 @@
+
+SHELL           = /bin/sh
+
+# SOURCE FILES
+
+SRCS_F90	= twocmp.con.F90		\
+		  twocmp.seq.F90		\
+		  twocmp.seqUnvn.F90		\
+		  twocmp.seqNB.F90		\
+
+OBJS_ALL	= $(SRCS_F90:.F90=.o)
+
+# MACHINE AND COMPILER FLAGS
+
+include ../../Makefile.conf
+
+# ADDITIONAL DEFINITIONS SPECIFIC FOR UTMCT COMPILATION
+
+MCTLIBS    = -L$(MPEUPATH) -L$(MCTPATH) -lmct -lmpeu 
+UTLDFLAGS  = $(REAL8)
+UTCMPFLAGS = $(REAL8) $(INCFLAG)$(MPEUPATH) $(INCFLAG)$(MCTPATH)
+
+# TARGETS
+
+all:	twocon twoseq twosequn twoseqNB
+
+twocon:  twocmp.con.o
+	$(FC) -o $@ twocmp.con.o $(FCFLAGS) $(UTLDFLAGS) $(MCTLIBS) $(MPILIBS)
+
+twoseq:  twocmp.seq.o
+	$(FC) -o $@ twocmp.seq.o $(FCFLAGS) $(UTLDFLAGS) $(MCTLIBS) $(MPILIBS)
+
+twosequn:  twocmp.seqUnvn.o
+	$(FC) -o $@ twocmp.seqUnvn.o $(FCFLAGS) $(UTLDFLAGS) $(MCTLIBS) $(MPILIBS)
+
+twoseqNB:  twocmp.seqNB.o
+	$(FC) -o $@ twocmp.seqNB.o $(FCFLAGS) $(MCTLIBS) $(MPILIBS)
+
+# RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .o
+
+.F90.o:
+	$(FC) -c $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MCTFLAGS) $(UTCMPFLAGS) $<
+
+
+clean:
+	${RM} *.o *.mod twocon twoseq twosequn twoseqNB
+
+# DEPENDENCIES:
+
+$(OBJS_ALL): $(MCTPATH)/libmct.a
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/README	(revision 4775)
@@ -0,0 +1,51 @@
+
+
+The programs in this directory demonstrate how to use basic
+functions of MCT in several possible coupled configurations of
+two components.
+
+Each example is contained in one .F90 file.
+
+To compile: 
+First make sure you have compiled MCT. See instructions in
+MCT/README
+
+Type "make" here or "make examples" in the top-level directory.
+
+To run:  Consult your local documentation for how to run a parallel
+program.  The examples below assume mpirun is available and you
+can run interactively.   "script.babyblue" is an example of run script
+for IBM systems which use a queue manager.
+
+----------------------------------------------------------------------
+twocomponent.concurrent.F90 - two components running concurrently on
+  separate pools of processors.
+
+  requires: at least 3 MPI processes
+  to run:  mpirun -np 3 twocon
+  note: will not work with mpi-serial
+
+------------------------------------------
+twocomponent.sequential.F90 - two components running sequentially on
+  the same processors.  Uses arguments to pass data between models.
+  Shows use of Rearranger.
+
+  requires: at least 1 MPI process
+  to run:  mpirun -np 1 twoseq
+
+------------------------------------------
+twocomponent.seqNB.F90      - two components running sequentially on
+  the same processors.  Uses non-blocking MCT calls to pass data between
+  models
+
+  requires: at least 1 MPI process
+  to run:  mpirun -np 1 twoseqNB
+
+------------------------------------------
+twocomponentUneven.sequential.F90 - two components running sequentially but
+  one model is only running on some of the shared processors.
+
+  requires: no more than 12 processors
+  to run:  mpirun -np 2 twosequn
+
+------------------------------------------
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/script.babyblue
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/script.babyblue	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/script.babyblue	(revision 4775)
@@ -0,0 +1,29 @@
+#! /usr/bin/csh -f 
+####################################################
+#
+#  Example run script for LoadLeveler, the queue
+#  system used on most IBM's.
+#
+#  Your site may require different options.
+#
+####################################################
+# @ output = utmct.stdout.$(jobid).$(stepid)
+# @ error  = utmct.stderr.$(jobid).$(stepid)
+# @ job_name = mctsimple
+# @ job_type = parallel
+# @ node = 4,4
+# @ tasks_per_node = 4
+# @ checkpoint = no
+# @ node_usage = not_shared
+# @ network.MPI = csss,not_shared,us 
+# @ class = share
+# @ notification = never
+# @ queue
+
+setenv MP_STDOUTMODE     ordered
+setenv MP_INFOLEVEL      2
+ 
+echo "`date` -- UTMCT EXECUTION BEGINS HERE" 
+poe twocon
+echo "`date` -- UTMCT EXECUTION finishes HERE" 
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.con.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.con.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.con.F90	(revision 4775)
@@ -0,0 +1,222 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS twocmp.con.F90,v 1.4 2006-07-25 22:31:34 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE:  twocomponent.concurrent
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect two
+!  components executing concurrently in a single executable.
+!  
+!
+! !INTERFACE:
+!
+      program twocon
+!
+! !USES:
+!
+!--- Use only the things needed from MCT
+      use m_MCTWorld,only: MCTWorld_init => init
+
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: MCT_GSMap_init => init
+      use m_GlobalSegMap,only: MCT_GSMap_lsize => lsize
+
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : MCT_AtrVt_init => init
+      use m_AttrVect,only    : MCT_AtrVt_zero => zero
+      use m_AttrVect,only    : MCT_AtrVt_lsize => lsize
+      use m_AttrVect,only    : MCT_AtrVt_indexRA => indexRA
+      use m_AttrVect,only    : MCT_AtrVt_importRA => importRAttr
+
+      use m_Router,only: Router
+      use m_Router,only: MCT_Router_init => init
+
+      use m_Transfer,only : MCT_Send => send
+      use m_Transfer,only : MCT_Recv => recv
+
+      implicit none
+
+      include 'mpif.h'
+!-----------------------------------------------------------------------
+      ! Local variables
+
+      integer,parameter :: npoints = 24  ! number of grid points
+
+      integer ier,nprocs
+      integer color,myrank,mycomm
+!-----------------------------------------------------------------------
+!  The Main program. 
+! We are implementing a single-executable, concurrent-execution system.
+! This small main program carves up MPI_COMM_WORLD and then starts
+! each component on its own processor set.
+
+      call MPI_init(ier)
+
+      call mpi_comm_size(MPI_COMM_WORLD, nprocs,ier)
+      call mpi_comm_rank(MPI_COMM_WORLD, myrank,ier)
+
+      if((nprocs .gt. 14).or.(nprocs .lt. 3)) then
+        write(6,*)"The small problem size in this example &
+        &requires between 3 and 14 processors."
+	write(6,*)"nprocs =",nprocs
+        stop
+      endif
+
+
+!  Force the model1 to run on the first 2 processors
+      color =1
+      if (myrank .lt. 2) then
+        color = 0
+      endif
+
+! Split MPI_COMM_WORLD into a communicator for each model
+      call mpi_comm_split(MPI_COMM_WORLD,color,0,mycomm,ier)
+
+! Start up the the models, pass in the communicators
+      if(color .eq. 0) then
+       call model1(mycomm)
+      else
+       call model2(mycomm)
+      endif
+
+! Models are finished.
+      call mpi_finalize(ier)
+
+      contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model1(comm1)   ! the first model
+
+      implicit none
+
+      integer :: comm1,mysize,ier,asize,myproc
+      integer :: fieldindx,avsize,i
+      integer,dimension(1) :: start,length
+      real,pointer :: testarray(:)
+      
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: av1
+      type(Router) :: Rout
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm1,mysize,ier)
+      call mpi_comm_rank(comm1,myproc,ier)
+      write(6,*)"model1 size",mysize
+
+!  initialize ThisMCTWorld
+      call MCTWorld_init(2,MPI_COMM_WORLD,comm1,1)
+
+!  set up a grid and decomposition
+      asize =  npoints/mysize
+
+      start(1)= (myproc*asize) +1
+      length(1)=asize
+
+!  describe decomposition with MCT GSmap type
+      call MCT_GSMap_init(GSMap,start,length,0,comm1,1)
+
+      write(6,*)"model 1 GSMap ngseg",myproc,GSMap%ngseg,start(1)
+
+!  Initialize an Attribute Vector
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap,comm1))
+
+      avsize = MCT_AtrVt_lsize(av1)
+      write(6,*)"model 1 av size", avsize
+
+!  Fill Av with some data
+!  fill first attribute the direct way
+      fieldindx = MCT_AtrVt_indexRA(av1,"field1")
+      do i=1,avsize
+        av1%rAttr(fieldindx,i) = float(i)
+      enddo
+
+!  fill second attribute using Av import function
+      allocate(testarray(avsize))
+      do i=1,avsize
+        testarray(i)= cos((float(i)/npoints) * 3.14)
+      enddo
+      call MCT_AtrVt_importRA(av1,"field2",testarray)
+
+!  initialize a Router
+      call MCT_Router_init(2,GSMap,comm1,Rout)
+
+!  print out Av data
+      do i=1,asize
+        write(6,*) "model 1 data", myproc,i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+      
+!  send the data
+      call MCT_Send(av1,Rout)
+
+
+
+      end subroutine model1
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model2(comm2)
+
+      implicit none
+
+      integer :: comm2,mysize,ier,asize,myproc
+      integer :: i
+      integer,dimension(1) :: start,length
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: av1
+      type(Router)   :: Rout
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm2,mysize,ier)
+      call mpi_comm_rank(comm2,myproc,ier)
+      write(6,*)"model2 size",mysize
+
+!  initialize ThisMCTWorld
+      call MCTWorld_init(2,MPI_COMM_WORLD,comm2,2)
+
+!  set up a grid and decomposition
+      asize =  npoints/mysize
+
+      start(1)= (myproc*asize) +1
+      length(1)=asize
+
+!  describe decomposition with MCT GSmap type
+      call MCT_GSMap_init(GSMap,start,length,0,comm2,2)
+
+      write(6,*)"model 2 GSMap ngseg",myproc,GSMap%ngseg,start(1)
+
+!  Initialize an Attribute Vector
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap,comm2))
+
+      write(6,*)"model 2 av size", MCT_AtrVt_lsize(av1)
+
+! initialize Av to be zero everywhere
+      call MCT_AtrVt_zero(av1)
+
+!  initialize a Router
+      call MCT_Router_init(1,GSMap,comm2,Rout)
+
+!  print out Av data before Recv
+      do i=1,asize
+        write(6,*) "model 2 data", myproc,i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+
+!  Recv the data
+      call MCT_Recv(av1,Rout)
+
+!  print out Av data after Recv.
+      do i=1,asize
+        write(6,*) "model 2 data after", myproc,i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+
+
+      end subroutine model2
+
+      end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seq.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seq.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seq.F90	(revision 4775)
@@ -0,0 +1,204 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS twocmp.seq.F90,v 1.6 2006-07-25 17:09:42 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE:  twocomponent.sequential
+!  
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect
+! two components executing in sequence in a single executable.
+!
+! Data is passed between models by using input/output arguments
+! in the run method.  Compare with twocmp.seqNB.F90
+!
+! !INTERFACE:
+!
+      program twoseq
+!
+! !USES:
+!
+!--- Get only the things needed from MCT
+      use m_MCTWorld,only: MCTWorld_init => init
+
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: MCT_GSMap_init => init
+      use m_GlobalSegMap,only: MCT_GSMap_lsize => lsize
+
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : MCT_AtrVt_init => init
+      use m_AttrVect,only    : MCT_AtrVt_zero => zero
+      use m_AttrVect,only    : MCT_AtrVt_lsize => lsize
+      use m_AttrVect,only    : MCT_AtrVt_indexRA => indexRA
+      use m_AttrVect,only    : MCT_AtrVt_importRA => importRAttr
+
+      use m_Rearranger,only: Rearranger
+      use m_Rearranger,only: MCT_Rearranger_init => init
+      use m_Rearranger,only: MCT_Rearrange => Rearrange
+
+      implicit none
+
+      include 'mpif.h'
+
+      integer,parameter :: ngx = 6   ! points in x-direction
+      integer,parameter :: ngy = 4   ! points in y-direction
+      integer ier,nprocs
+      integer,dimension(:),pointer :: myids
+      integer :: comm1,comm2,asize,mysize,i,myproc
+      integer,dimension(1) :: start1,length1
+      integer,dimension(:),pointer :: start2,length2
+!-----------------------------------------------------------------------
+!  The Main program. 
+! We are implementing a single-executable, sequential-execution system.
+! In this example, communication occurs through main using
+! arguments.  Both components share the same processors.
+
+      type(GlobalSegMap) :: GSmap1,GSmap2
+      type(AttrVect) :: av1,av2
+      type(Rearranger) :: Rearr
+!-----------------------------------------------------------------------
+
+      call MPI_init(ier)
+
+      call mpi_comm_size(MPI_COMM_WORLD, mysize,ier)
+      if(mysize .gt. 4) then
+        write(6,*)"The small problem size in this example &
+	&requires ", ngy,"or fewer processors."
+        stop
+      endif
+      call mpi_comm_rank(MPI_COMM_WORLD, myproc,ier)
+
+      call mpi_comm_dup(MPI_COMM_WORLD,comm1,ier)
+      call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
+
+      allocate(myids(2))
+      myids(1)=1
+      myids(2)=2
+
+      call MCTWorld_init(2,MPI_COMM_WORLD,comm1,myids=myids)
+
+!  set up a grid and decomposition
+! first gsmap is the grid decomposed by rows
+! theres 1 segment per processor
+      length1(1)= ngx * (ngy/mysize)
+      start1(1)= myproc * length1(1) + 1
+
+       write(6,*)'gsmap1', myproc,length1(1),start1(1)
+      call MCT_GSMap_init(GSMap1,start1,length1,0,comm1,1)
+
+! second gsmap is the grid decomposed by columns
+      allocate(length2(ngy),start2(ngy))
+
+      do i=1,ngy
+       length2(i)=ngx/mysize
+       start2(i)= (i-1)*ngx + 1 + myproc*length2(i)
+       write(6,*) 'gsmap2',myproc,i,length2(i),start2(i)
+      enddo
+   
+
+      call MCT_GSMap_init(GSMap2,start2,length2,0,comm2,2)
+
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap1,comm1))
+
+      call MCT_AtrVt_init(av2,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap2,comm2))
+
+
+! create a rearranger
+      call MCT_Rearranger_init(GSMap1,GSMap2,MPI_COMM_WORLD,Rearr)
+
+!-------------end of initialization steps
+
+
+! Start up model1 which fills av1 with data.
+      call model1(comm1,av1)
+
+!  print out Av data
+      do i=1,MCT_AtrVt_lsize(av1)
+        write(6,*) "model 1 data", myproc,i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+      
+! rearrange data from model1 so that model2 can use it.
+      call MCT_Rearrange(av1,av2,Rearr)
+
+! pass data to model2 (which will print it out)
+      call model2(comm2,av2)
+
+
+! all done
+      call mpi_finalize(ier)
+
+      contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model1(comm1,mod1av)   ! the first model
+
+      implicit none
+
+      integer :: comm1,mysize,ier,asize,myproc
+      integer :: fieldindx,avsize,i
+      integer,dimension(1) :: start,length
+      real,pointer :: testarray(:)
+      
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: mod1av
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm1,mysize,ier)
+      call mpi_comm_rank(comm1,myproc,ier)
+      write(6,*)"model1 size",mysize
+
+
+      avsize = MCT_AtrVt_lsize(mod1av)
+      write(6,*)"model 1 av size", avsize
+
+!  Fill Av with some data
+!  fill first attribute the direct way
+      fieldindx = MCT_AtrVt_indexRA(mod1av,"field1")
+      do i=1,avsize
+        mod1av%rAttr(fieldindx,i) = float(i+ 20*myproc)
+      enddo
+
+!  fill second attribute using Av import function
+      allocate(testarray(avsize))
+      do i=1,avsize
+        testarray(i)= cos((float(i+ 20*myproc)/24.) * 3.14)
+      enddo
+      call MCT_AtrVt_importRA(mod1av,"field2",testarray)
+
+
+      end subroutine model1
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model2(comm2,mod2av)
+
+      implicit none
+
+      integer :: comm2,mysize,ier,asize,myproc
+      integer :: i
+      type(AttrVect) :: mod2av 
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm2,mysize,ier)
+      call mpi_comm_rank(comm2,myproc,ier)
+      write(6,*)"model2 size",mysize
+
+      asize = MCT_AtrVt_lsize(mod2av)
+      write(6,*)"model 2 av size", asize
+
+!  print out Av data
+      do i=1,asize
+        write(6,*) "model 2 data after", myproc,i,mod2av%rAttr(1,i),mod2av%rAttr(2,i)
+      enddo
+
+
+      end subroutine model2
+
+      end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqNB.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqNB.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqNB.F90	(revision 4775)
@@ -0,0 +1,283 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS twocmp.seqNB.F90,v 1.4 2004-06-24 21:07:01 eong Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE:  twocmp.seqNB
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect to 
+!  components executing sequentially in a single executable using
+!  the non-blocking communications to transfer data.
+!  
+!
+! !INTERFACE:
+!
+      program twocmpseqNB
+!
+! !USES:
+!
+!--- Use only the things needed from MCT
+      use m_MCTWorld,only: MCTWorld_init => init
+
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: MCT_GSMap_init => init
+      use m_GlobalSegMap,only: MCT_GSMap_lsize => lsize
+      use m_GlobalSegMapComms,only: MCT_GSMap_recv => recv
+      use m_GlobalSegMapComms,only: MCT_GSMap_isend => isend
+      use m_GlobalSegMapComms,only: MCT_GSMap_bcast => bcast
+
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : MCT_AtrVt_init => init
+      use m_AttrVect,only    : MCT_AtrVt_zero => zero
+      use m_AttrVect,only    : MCT_AtrVt_lsize => lsize
+      use m_AttrVect,only    : MCT_AtrVt_indexRA => indexRA
+      use m_AttrVect,only    : MCT_AtrVt_importRA => importRAttr
+
+      use m_Router,only: Router
+      use m_Router,only: MCT_Router_init => init
+
+      use m_Transfer,only : MCT_ISend => isend
+      use m_Transfer,only : MCT_Recv => recv
+
+      implicit none
+
+      include 'mpif.h'
+
+      integer,parameter :: npoints = 24  ! total number of grid points
+      integer ier,nprocs,i
+      integer color,myrank,comm1,comm2
+      integer,dimension(:),pointer :: myids
+      integer,dimension(:),pointer :: req1,req2
+!-----------------------------------------------------------------------
+!  The Main program. 
+! We are implementing a single-executable, seqeuntial-execution system.
+! This small main program sets up MCTWorld, calls each "init" method
+! and then calls each component in turn.
+
+      type(GlobalSegMap) :: GSMap1,GSMap2
+      type(AttrVect) :: Av1,Av2
+
+      call MPI_init(ier)
+
+      call mpi_comm_size(MPI_COMM_WORLD, nprocs,ier)
+      call mpi_comm_rank(MPI_COMM_WORLD, myrank,ier)
+
+! Duplicate MPI_COMM_WORLD into a communicator for each model
+      call mpi_comm_dup(MPI_COMM_WORLD,comm1,ier)
+      call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
+
+      allocate(myids(2))
+      myids(1)=1
+      myids(2)=2
+
+! Initialize MCT world
+      call MCTWorld_init(2,MPI_COMM_WORLD,comm1,myids=myids)
+
+! Initialize the models, pass in the communicators
+      call model1init(comm1,req1,GSMap1,Av1)
+      call model2init(comm2,req2,GSMap2,Av2)
+
+!-----------------end of initialization phase ------
+! Run the models, pass in the communicators
+      do i=1,5
+       write(6,*) " "
+       write(6,*) "Step ",i
+       call model1(comm1,GSMap1,Av1)
+       call model2(comm2,GSMap2,Av2)
+      enddo
+
+! Models are finished.
+      call mpi_finalize(ier)
+
+      contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model1init(comm1,req1,GSmap,av1)   ! init the first model
+
+      implicit none
+
+      integer :: comm1,mysize,ier,asize,myproc
+      integer :: fieldindx,avsize,i
+      integer,dimension(1) :: start,length
+      real,pointer :: testarray(:)
+      integer,pointer :: req1(:)
+      
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: av1
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm1,mysize,ier)
+      call mpi_comm_rank(comm1,myproc,ier)
+      write(6,*)myproc,"model1 size",mysize
+
+!  set up a grid and decomposition
+      asize =  npoints/mysize
+
+      start(1)= (myproc*asize) +1
+      length(1)=asize
+
+!  describe decomposition with MCT GSmap type
+      call MCT_GSMap_init(GSMap,start,length,0,comm1,1)
+
+      write(6,*)myproc,"model 1 GSMap ngseg",GSMap%ngseg,start(1)
+
+      if(myproc .eq. 0) call MCT_GSMap_Isend(GSMap,2,100,req1)
+
+!  Initialize an Attribute Vector
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap,comm1))
+      write(6,*)myproc,"model1 got an aV"
+
+      avsize = MCT_AtrVt_lsize(av1)
+      write(6,*)myproc,"model 1 av size", avsize
+
+      end subroutine model1init
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+      subroutine model1(comm1,GSmap,av1)   ! run the first model
+
+      implicit none
+
+      integer :: comm1,mysize,ier,asize,myproc
+      integer :: fieldindx,avsize,i
+      integer,dimension(1) :: start,length
+      real,pointer :: testarray(:)
+      
+      type(GlobalSegMap) :: GSmap,GSmap2
+      type(AttrVect) :: av1
+      type(Router),save :: Rout
+      logical,save :: firsttime=.FALSE.
+
+      call mpi_comm_rank(comm1,myproc,ier)
+
+      if(.not.firsttime) then
+!  get other GSMap
+        if(myproc .eq. 0) call MCT_GSMap_recv(GSmap2,2,110)
+	call MCT_GSMap_bcast(GSmap2,0,comm1)
+! initialize a router
+        call MCT_Router_init(GSMap,GSmap2,comm1,Rout)
+      endif
+      firsttime=.TRUE.
+
+      avsize = MCT_AtrVt_lsize(av1)
+
+!  Fill Av with some data
+!  fill first attribute the direct way
+      fieldindx = MCT_AtrVt_indexRA(av1,"field1")
+      do i=1,avsize
+        av1%rAttr(fieldindx,i) = float(i +20*myproc)
+      enddo
+
+!  fill second attribute using Av import function
+      allocate(testarray(avsize))
+      do i=1,avsize
+        testarray(i)= cos((float(i+ 20*myproc)/npoints) * 3.14)
+      enddo
+      call MCT_AtrVt_importRA(av1,"field2",testarray)
+
+!  print out Av data
+      do i=1,avsize
+        write(6,*)myproc, "model 1 data", i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+      
+!  send the data
+      call MCT_ISend(av1,Rout)
+
+
+
+      end subroutine model1
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model2init(comm2,req2,GSmap,av1)  ! init model 2
+
+      implicit none
+
+      integer :: comm2,mysize,ier,asize,myproc
+      integer :: i
+      integer,dimension(1) :: start,length
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: av1
+      integer,pointer :: req2(:)
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm2,mysize,ier)
+      call mpi_comm_rank(comm2,myproc,ier)
+      write(6,*)myproc,"model2 size",mysize
+
+!  set up a grid and decomposition
+      asize =  npoints/mysize
+
+      start(1)= (myproc*asize) +1
+      length(1)=asize
+
+!  describe decomposition with MCT GSmap type
+      call MCT_GSMap_init(GSMap,start,length,0,comm2,2)
+
+      write(6,*)myproc, "model 2 GSMap ngseg",GSMap%ngseg,start(1)
+
+      if(myproc .eq. 0) call MCT_GSMap_Isend(GSMap,1,110,req2)
+
+!  Initialize an Attribute Vector
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap,comm2))
+      write(6,*)myproc,"model2 got an aV"
+
+      write(6,*)myproc, "model 2 av size", MCT_AtrVt_lsize(av1)
+
+      end subroutine model2init
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model2(comm2,GSmap,av1)
+
+      implicit none
+
+      integer :: comm2,mysize,ier,avsize,myproc
+      integer :: i
+      integer,dimension(1) :: start,length
+      type(GlobalSegMap) :: GSmap,GSmap2
+      type(AttrVect) :: av1
+      type(Router),save   :: Rout
+      logical,save :: firsttime=.FALSE.
+!---------------------------
+
+! initialize Av to be zero everywhere
+      call MCT_AtrVt_zero(av1)
+
+      call mpi_comm_rank(comm2,myproc,ier)
+      if(.not.firsttime) then
+! receive other GSMap
+        if(myproc .eq. 0) call MCT_GSMap_recv(GSmap2,1,100)
+	call MCT_GSMap_bcast(GSmap2,0,comm2)
+!  initialize a Router
+        call MCT_Router_init(GSMap,GSmap2,comm2,Rout)
+      endif
+      firsttime=.TRUE.
+
+      avsize = MCT_AtrVt_lsize(av1)
+
+!  print out Av data before Recv
+      do i=1,avsize
+        write(6,*) myproc,"model 2 data", i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+
+!  Recv the data
+      call MCT_Recv(av1,Rout)
+
+!  print out Av data after Recv.
+      do i=1,avsize
+        write(6,*) myproc,"model 2 data after", i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+
+
+      end subroutine model2
+
+      end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqUnvn.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqUnvn.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/examples/simple/twocmp.seqUnvn.F90	(revision 4775)
@@ -0,0 +1,242 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS twocmp.seqUnvn.F90,v 1.6 2007-12-19 17:13:17 rloy Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !ROUTINE:  twocomponentUneven.sequential
+!
+! !DESCRIPTION:  Provide a simple example of using MCT to connect two components
+!   In this case the models are running sequentialy but the second model
+!   is only running on 1 processor.
+!
+! !INTERFACE:
+!
+      program twosequn
+!
+! !USES:
+!
+!--- Get only the things needed from MCT
+      use m_MCTWorld,only: MCTWorld_init => init
+
+      use m_GlobalSegMap,only: GlobalSegMap
+      use m_GlobalSegMap,only: MCT_GSMap_init => init
+      use m_GlobalSegMap,only: MCT_GSMap_lsize => lsize
+
+      use m_AttrVect,only    : AttrVect
+      use m_AttrVect,only    : MCT_AtrVt_init => init
+      use m_AttrVect,only    : MCT_AtrVt_zero => zero
+      use m_AttrVect,only    : MCT_AtrVt_lsize => lsize
+      use m_AttrVect,only    : MCT_AtrVt_indexRA => indexRA
+      use m_AttrVect,only    : MCT_AtrVt_importRA => importRAttr
+
+      use m_Rearranger,only: Rearranger
+      use m_Rearranger,only: MCT_Rearranger_init => init
+      use m_Rearranger,only: MCT_Rearrange => Rearrange
+
+      implicit none
+
+      include 'mpif.h'
+
+      integer,parameter :: ngx = 6   ! points in x-direction
+      integer,parameter :: ngy = 4   ! points in y-direction
+
+      integer ier,world_group,model2_group,myrank2,myrank3
+      integer,dimension(:),pointer :: myids,mycomms,peloc2
+      integer,dimension(:,:),pointer :: GlobalId
+      integer :: comm1,comm2,asize,mysize,i,myproc
+      integer :: commsize
+      integer,dimension(1) :: start1,length1,ranks
+      integer,dimension(:),allocatable :: start2,length2
+!-----------------------------------------------------------------------
+!  The Main program. 
+! We are implementing a single-executable, sequential-execution system.
+! Because its sequential, communication occurs through the main using
+! arguments.  The second component is only running on 1 processor
+
+      type(GlobalSegMap) :: GSmap1,GSmap2
+      type(AttrVect) :: av1,av2
+      type(Rearranger) :: Rearr
+
+      call MPI_init(ier)
+
+      call mpi_comm_size(MPI_COMM_WORLD, mysize,ier)
+      if(mysize .gt. 12) then
+        write(6,*)"Must run on less than 12 processors"
+        stop
+      endif
+      call mpi_comm_rank(MPI_COMM_WORLD, myproc,ier)
+
+!  the first model is running on all the processors so give
+!  it a dubplicate of MPI_COMM_WORLD for its communicator
+      call mpi_comm_dup(MPI_COMM_WORLD,comm1,ier)
+
+!  the second model is only running on one processor
+!  so use mpi_groups methods to define its communicator
+      call mpi_comm_group(MPI_COMM_WORLD,world_group,ier)
+
+! need a communicator that only has the first processor
+      ranks(1)=0
+! define the group
+      call mpi_group_incl(world_group,1,ranks,model2_group,ier)
+! now define the communicator
+      ! first initialize it
+      comm2=MPI_COMM_NULL
+      call mpi_comm_create(MPI_COMM_WORLD,model2_group,comm2,ier)
+
+! don't need the groups anymore
+      call mpi_group_free(world_group,ier)
+      call mpi_group_free(model2_group,ier)
+
+!  allocate arrays for the ids and comms
+      allocate(myids(2),mycomms(2))
+
+! Set the arrays to their values.
+      myids(1)=1
+      myids(2)=2
+      mycomms(1)=comm1
+      mycomms(2)=comm2
+
+! now call the initm_ version of MCTWorld_init
+      call MCTWorld_init(2,MPI_COMM_WORLD,mycomms,myids)
+
+
+! first gsmap is the grid decomposed in one dimension
+! there is 1 segment per processor
+      length1(1)= (ngx * ngy)/mysize
+      start1(1)= myproc * length1(1) + 1
+
+      write(6,*)'gsmap1', myproc,length1(1),start1(1)
+      call MCT_GSMap_init(GSMap1,start1,length1,0,comm1,1)
+
+! second gsmap is the grid on one processor
+
+! for GSMap init to work, the size of the start and length arrays
+! must equal the number of local segments.  So I must allocate
+! size zero arrays on the other processors.
+      if(myproc .eq. 0) then
+       allocate(start2(1),length2(1))
+       length2(1) = ngx*ngy
+       start2(1) = 1
+      else
+       allocate(start2(0),length2(0))
+      endif
+   
+      call MCT_GSMap_init(GSMap2,start2,length2,0,comm1,2)
+      write(6,*)'gsmap2', myproc,GSMap2%ngseg,GSmap2%gsize,GSmap2%start(1), &
+                  GSmap2%pe_loc(1),GSmap2%length(1)
+
+
+! initialize an Av on each GSMap
+      call MCT_AtrVt_init(av1,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap1,comm1))
+
+!  Use comm1 because lsize of GSMap2 on comm1 will return 0 on non-root processors.
+!  We need av2 to be full-sized on proc 0 and 0 size on other processors.
+      call MCT_AtrVt_init(av2,rList="field1:field2",lsize=MCT_GSMap_lsize(GSMap2,comm1))
+
+
+! create a rearranger.  Use the communicator which contains all processors 
+! involved in the rearrangement, comm1
+      call MCT_Rearranger_init(GSMap1,GSMap2,comm1,Rearr)
+
+!-------------end of initialization steps
+
+
+! Start up model1 which fills av1 with data.
+      call model1(comm1,av1)
+
+!  print out Av data
+      do i=1,MCT_AtrVt_lsize(av1)
+        write(6,*) "model 1 data", myproc,i,av1%rAttr(1,i),av1%rAttr(2,i)
+      enddo
+      
+! rearrange data from model1 so that model2 can use it.
+      call MCT_Rearrange(av1,av2,Rearr)
+
+! pass data to model2 (which will print it out)
+! model2 should only run on one processor.
+      if(myproc .eq. 0) then
+        call model2(comm2,av2)
+      endif
+
+
+! all done
+      call MPI_Barrier(MPI_COMM_WORLD,ier)
+      if (myproc==0) write(6,*) 'All Done'
+
+      call mpi_finalize(ier)
+
+      contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model1(comm1,mod1av)   ! the first model
+
+      implicit none
+
+      integer :: comm1,mysize,ier,asize,myproc
+      integer :: fieldindx,avsize,i
+      integer,dimension(1) :: start,length
+      real,pointer :: testarray(:)
+      
+      type(GlobalSegMap) :: GSmap
+      type(AttrVect) :: mod1av
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm1,mysize,ier)
+      call mpi_comm_rank(comm1,myproc,ier)
+      write(6,*)"model1 myproc,mysize",myproc,mysize
+
+
+      avsize = MCT_AtrVt_lsize(mod1av)
+      write(6,*)"model 1 myproc, av size", myproc,avsize
+
+!  Fill Av with some data
+!  fill first attribute the direct way
+      fieldindx = MCT_AtrVt_indexRA(mod1av,"field1")
+      do i=1,avsize
+        mod1av%rAttr(fieldindx,i) = float(i+ 20*myproc)
+      enddo
+
+!  fill second attribute using Av import function
+      allocate(testarray(avsize))
+      do i=1,avsize
+        testarray(i)= cos((float(i+ 20*myproc)/24.) * 3.14)
+      enddo
+      call MCT_AtrVt_importRA(mod1av,"field2",testarray)
+
+
+      end subroutine model1
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! !ROUTINE: 
+      subroutine model2(comm2,mod2av)
+
+      implicit none
+
+      integer :: comm2,mysize,ier,asize,myproc
+      integer :: i
+      type(AttrVect) :: mod2av 
+!---------------------------
+
+!  find local rank and size
+      call mpi_comm_size(comm2,mysize,ier)
+      call mpi_comm_rank(comm2,myproc,ier)
+      write(6,*)"model2 myproc,mysize",myproc,mysize
+
+      asize = MCT_AtrVt_lsize(mod2av)
+      write(6,*)"model 2 myproc, av size", myproc,asize
+
+!  print out Av data
+      do i=1,asize
+        write(6,*) "model 2 data after", myproc,i,mod2av%rAttr(1,i),mod2av%rAttr(2,i)
+      enddo
+
+
+      end subroutine model2
+
+      end
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/install-sh
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/install-sh	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/install-sh	(revision 4775)
@@ -0,0 +1,276 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission.  M.I.T. makes no representations about the
+# suitability of this software for any purpose.  It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.  It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+    case $1 in
+	-c) instcmd=$cpprog
+	    shift
+	    continue;;
+
+	-d) dir_arg=true
+	    shift
+	    continue;;
+
+	-m) chmodcmd="$chmodprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-o) chowncmd="$chownprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-g) chgrpcmd="$chgrpprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-s) stripcmd=$stripprog
+	    shift
+	    continue;;
+
+	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
+	    shift
+	    continue;;
+
+	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+	    shift
+	    continue;;
+
+	*)  if [ x"$src" = x ]
+	    then
+		src=$1
+	    else
+		# this colon is to work around a 386BSD /bin/sh bug
+		:
+		dst=$1
+	    fi
+	    shift
+	    continue;;
+    esac
+done
+
+if [ x"$src" = x ]
+then
+	echo "$0: no input file specified" >&2
+	exit 1
+else
+	:
+fi
+
+if [ x"$dir_arg" != x ]; then
+	dst=$src
+	src=""
+
+	if [ -d "$dst" ]; then
+		instcmd=:
+		chmodcmd=""
+	else
+		instcmd=$mkdirprog
+	fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+	if [ -f "$src" ] || [ -d "$src" ]
+	then
+		:
+	else
+		echo "$0: $src does not exist" >&2
+		exit 1
+	fi
+
+	if [ x"$dst" = x ]
+	then
+		echo "$0: no destination specified" >&2
+		exit 1
+	else
+		:
+	fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+	if [ -d "$dst" ]
+	then
+		dst=$dst/`basename "$src"`
+	else
+		:
+	fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+#  this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+	'
+IFS="${IFS-$defaultIFS}"
+
+oIFS=$IFS
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS=$oIFS
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+	pathcomp=$pathcomp$1
+	shift
+
+	if [ ! -d "$pathcomp" ] ;
+        then
+		$mkdirprog "$pathcomp"
+	else
+		:
+	fi
+
+	pathcomp=$pathcomp/
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+	$doit $instcmd "$dst" &&
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd "$dst"; else : ; fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd "$dst"; else : ; fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd "$dst"; else : ; fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd "$dst"; else : ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+	if [ x"$transformarg" = x ]
+	then
+		dstfile=`basename "$dst"`
+	else
+		dstfile=`basename "$dst" $transformbasename |
+			sed $transformarg`$transformbasename
+	fi
+
+# don't allow the sed command to completely eliminate the filename
+
+	if [ x"$dstfile" = x ]
+	then
+		dstfile=`basename "$dst"`
+	else
+		:
+	fi
+
+# Make a couple of temp file names in the proper directory.
+
+	dsttmp=$dstdir/#inst.$$#
+	rmtmp=$dstdir/#rm.$$#
+
+# Trap to clean up temp files at exit.
+
+	trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0
+	trap '(exit $?); exit' 1 2 13 15
+
+# Move or copy the file name to the temp name
+
+	$doit $instcmd "$src" "$dsttmp" &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing.  If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd "$dsttmp"; else :;fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd "$dsttmp"; else :;fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd "$dsttmp"; else :;fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd "$dsttmp"; else :;fi &&
+
+# Now remove or move aside any old file at destination location.  We try this
+# two ways since rm can't unlink itself on some systems and the destination
+# file might be busy for other reasons.  In this case, the final cleanup
+# might fail but the new file should still install successfully.
+
+{
+	if [ -f "$dstdir/$dstfile" ]
+	then
+		$doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null ||
+		$doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null ||
+		{
+		  echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2
+		  (exit 1); exit
+		}
+	else
+		:
+	fi
+} &&
+
+# Now rename the file to the real destination.
+
+	$doit $mvcmd "$dsttmp" "$dstdir/$dstfile"
+
+fi &&
+
+# The final little trick to "correctly" pass the exit status to the exit trap.
+
+{
+	(exit 0); exit
+}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/README	(revision 4775)
@@ -0,0 +1,5 @@
+This directory contains some specific tests used in the MCT autoconf system.
+They are placed here to make the configure.ac a little cleaner.
+
+These are only needed if you are trying to recreate the "configure" script from
+the "configure.ac" file.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/acx_mpi.m4
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/acx_mpi.m4	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/acx_mpi.m4	(revision 4775)
@@ -0,0 +1,146 @@
+dnl @synopsis ACX_MPI([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+dnl
+dnl @summary figure out how to compile/link code with MPI
+dnl
+dnl This macro tries to find out how to compile programs that use MPI
+dnl (Message Passing Interface), a standard API for parallel process
+dnl communication (see http://www-unix.mcs.anl.gov/mpi/)
+dnl
+dnl On success, it sets the MPICC, MPICXX, or MPIF77 output variable to
+dnl the name of the MPI compiler, depending upon the current language.
+dnl (This may just be $CC/$CXX/$F77, but is more often something like
+dnl mpicc/mpiCC/mpif77.) It also sets MPILIBS to any libraries that are
+dnl needed for linking MPI (e.g. -lmpi, if a special
+dnl MPICC/MPICXX/MPIF77 was not found).
+dnl
+dnl If you want to compile everything with MPI, you should set:
+dnl
+dnl     CC="$MPICC" #OR# CXX="$MPICXX" #OR# F77="$MPIF77"
+dnl     LIBS="$MPILIBS $LIBS"
+dnl
+dnl NOTE: The above assumes that you will use $CC (or whatever) for
+dnl linking as well as for compiling. (This is the default for automake
+dnl and most Makefiles.)
+dnl
+dnl The user can force a particular library/compiler by setting the
+dnl MPICC/MPICXX/MPIF77 and/or MPILIBS environment variables.
+dnl
+dnl ACTION-IF-FOUND is a list of shell commands to run if an MPI
+dnl library is found, and ACTION-IF-NOT-FOUND is a list of commands to
+dnl run it if it is not found. If ACTION-IF-FOUND is not specified, the
+dnl default action will define HAVE_MPI.
+dnl
+dnl @category InstalledPackages
+dnl @author Steven G. Johnson <stevenj@alum.mit.edu>
+dnl @author Julian Cummings <cummings@cacr.caltech.edu>
+dnl @version 2006-10-13
+dnl @license GPLWithACException
+
+AC_DEFUN([ACX_MPI], [
+AC_PREREQ(2.50) dnl for AC_LANG_CASE
+
+AC_LANG_CASE([C], [
+	AC_REQUIRE([AC_PROG_CC])
+	AC_ARG_VAR(MPICC,[MPI C compiler command])
+	AC_CHECK_PROGS(MPICC, mpicc hcc mpxlc_r mpxlc mpcc cmpicc, $CC)
+	acx_mpi_save_CC="$CC"
+	CC="$MPICC"
+	AC_SUBST(MPICC)
+],
+[C++], [
+	AC_REQUIRE([AC_PROG_CXX])
+	AC_ARG_VAR(MPICXX,[MPI C++ compiler command])
+	AC_CHECK_PROGS(MPICXX, mpic++ mpicxx mpiCC hcp mpxlC_r mpxlC mpCC cmpic++, $CXX)
+	acx_mpi_save_CXX="$CXX"
+	CXX="$MPICXX"
+	AC_SUBST(MPICXX)
+],
+[Fortran 77], [
+	AC_REQUIRE([AC_PROG_F77])
+	AC_ARG_VAR(MPIF77,[MPI Fortran 77 compiler command])
+	AC_CHECK_PROGS(MPIF77, mpif77 hf77 mpxlf mpf77 mpif90 mpf90 mpxlf90 mpxlf95 mpxlf_r cmpifc cmpif90c, $F77)
+	acx_mpi_save_F77="$F77"
+	F77="$MPIF77"
+	AC_SUBST(MPIF77)
+],
+[Fortran], [
+	AC_REQUIRE([AC_PROG_FC])
+	AC_ARG_VAR(MPIFC,[MPI Fortran compiler command])
+	AC_CHECK_PROGS(MPIFC, mpif90 hf90 mpxlf90 mpxlf95 mpf90 cmpifc cmpif90c, $FC)
+	acx_mpi_save_FC="$FC"
+	FC="$MPIFC"
+	AC_SUBST(MPIFC)
+])
+
+if test x = x"$MPILIBS"; then
+	AC_LANG_CASE([C], [AC_CHECK_FUNC(MPI_Init, [MPILIBS=" "])],
+		[C++], [AC_CHECK_FUNC(MPI_Init, [MPILIBS=" "])],
+		[Fortran 77], [AC_MSG_CHECKING([for MPI_Init])
+			AC_LINK_IFELSE([AC_LANG_PROGRAM([],[      call MPI_Init])],[MPILIBS=" "
+				AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no)])],
+		[Fortran], [AC_MSG_CHECKING([for MPI_Init])
+			AC_LINK_IFELSE([AC_LANG_PROGRAM([],[      call MPI_Init])],[MPILIBS=" "
+				AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no)])])
+fi
+AC_LANG_CASE([Fortran 77], [
+	if test x = x"$MPILIBS"; then
+		AC_CHECK_LIB(fmpi, MPI_Init, [MPILIBS="-lfmpi"])
+	fi
+	if test x = x"$MPILIBS"; then
+		AC_CHECK_LIB(fmpich, MPI_Init, [MPILIBS="-lfmpich"])
+	fi
+],
+[Fortran], [
+	if test x = x"$MPILIBS"; then
+		AC_CHECK_LIB(fmpi, MPI_Init, [MPILIBS="-lfmpi"])
+	fi
+	if test x = x"$MPILIBS"; then
+		AC_CHECK_LIB(mpichf90, MPI_Init, [MPILIBS="-lmpichf90"])
+	fi
+])
+if test x = x"$MPILIBS"; then
+	AC_CHECK_LIB(mpi, MPI_Init, [MPILIBS="-lmpi"])
+fi
+if test x = x"$MPILIBS"; then
+	AC_CHECK_LIB(mpich, MPI_Init, [MPILIBS="-lmpich"])
+fi
+
+dnl We have to use AC_TRY_COMPILE and not AC_CHECK_HEADER because the
+dnl latter uses $CPP, not $CC (which may be mpicc).
+AC_LANG_CASE([C], [if test x != x"$MPILIBS"; then
+	AC_MSG_CHECKING([for mpi.h])
+	AC_TRY_COMPILE([#include <mpi.h>],[],[AC_MSG_RESULT(yes)], [MPILIBS=""
+		AC_MSG_RESULT(no)])
+fi],
+[C++], [if test x != x"$MPILIBS"; then
+	AC_MSG_CHECKING([for mpi.h])
+	AC_TRY_COMPILE([#include <mpi.h>],[],[AC_MSG_RESULT(yes)], [MPILIBS=""
+		AC_MSG_RESULT(no)])
+fi],
+[Fortran 77], [if test x != x"$MPILIBS"; then
+	AC_MSG_CHECKING([for mpif.h])
+	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([],[      include 'mpif.h'])],[AC_MSG_RESULT(yes)], [MPILIBS=""
+		AC_MSG_RESULT(no)])
+fi],
+[Fortran], [if test x != x"$MPILIBS"; then
+	AC_MSG_CHECKING([for mpif.h])
+	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([],[      include 'mpif.h'])],[AC_MSG_RESULT(yes)], [MPILIBS=""
+		AC_MSG_RESULT(no)])
+fi])
+
+AC_LANG_CASE([C], [CC="$acx_mpi_save_CC"],
+	[C++], [CXX="$acx_mpi_save_CXX"],
+	[Fortran 77], [F77="$acx_mpi_save_F77"],
+	[Fortran], [FC="$acx_mpi_save_FC"])
+
+AC_SUBST(MPILIBS)
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x = x"$MPILIBS"; then
+        $2
+        :
+else
+        ifelse([$1],,[AC_DEFINE(HAVE_MPI,1,[Define if you have the MPI library.])],[$1])
+        :
+fi
+])dnl ACX_MPI
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/ax_fc_version.m4
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/ax_fc_version.m4	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/ax_fc_version.m4	(revision 4775)
@@ -0,0 +1,51 @@
+#AX_FC_VERSION_OUTPUT([FLAG = $ac_cv_prog_fc_version])
+# -------------------------------------------------
+# Link a trivial Fortran program, compiling with a version output FLAG
+# (which default value, $ac_cv_prog_fc_version, is computed by
+# AX_FC_VERSION), and return the output in $ac_fc_version_output.  
+AC_DEFUN([AX_FC_VERSION_OUTPUT],
+[AC_REQUIRE([AC_PROG_FC])dnl
+AC_LANG_PUSH(Fortran)dnl
+
+AC_LANG_CONFTEST([AC_LANG_PROGRAM([])])
+
+# Compile and link our simple test program by passing a flag (argument
+# 1 to this macro) to the Fortran 90 compiler in order to get "version" output 
+ac_save_FCFLAGS=$FCFLAGS
+FCFLAGS="$FCFLAGS m4_default([$1], [$ac_cv_prog_fc_version])"
+(eval echo $as_me:__oline__: \"$ac_link\") >&AS_MESSAGE_LOG_FD
+ac_fc_version_output=`eval $ac_link AS_MESSAGE_LOG_FD>&1 2>&1 | grep -v 'Driving:'`
+echo "$ac_fc_version_output" >&AS_MESSAGE_LOG_FD
+FCFLAGS=$ac_save_FCFLAGS
+
+rm -f conftest.*
+AC_LANG_POP(Fortran)dnl
+
+])# AX_FC_VERSION_OUTPUT
+
+# AX_FC_VERSION
+# --------------
+#
+AC_DEFUN([AX_FC_VERSION],
+[AC_CACHE_CHECK([how to get the version output from $FC],
+                [ac_cv_prog_fc_version],
+[AC_LANG_ASSERT(Fortran)
+AC_COMPILE_IFELSE([AC_LANG_PROGRAM()],
+[ac_cv_prog_fc_version=
+# Try some options frequently used verbose output
+for ac_version in -V -version --version +version -qversion; do
+  AX_FC_VERSION_OUTPUT($ac_version)
+  # look for "copyright" constructs in the output
+  for ac_arg in $ac_fc_version_output; do
+     case $ac_arg in
+        COPYRIGHT | copyright | Copyright | '(c)' | '(C)' | Compiler | Compilers | Version | Version:)
+          ac_cv_prog_fc_version=$ac_version
+          break 2 ;;
+     esac
+  done
+done
+if test -z "$ac_cv_prog_fc_version"; then
+   AC_MSG_WARN([cannot determine how to obtain version information from $FC])
+fi],
+                  [AC_MSG_WARN([compilation failed])])
+])])# AX_FC_VERSION
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/fortran.m4
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/fortran.m4	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/m4/fortran.m4	(revision 4775)
@@ -0,0 +1,855 @@
+# This file is part of Autoconf.                       -*- Autoconf -*-
+# Fortran languages support.
+# Copyright (C) 2001, 2003-2011 Free Software Foundation, Inc.
+
+# This file is part of Autoconf.  This program is free
+# software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the
+# Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# Under Section 7 of GPL version 3, you are granted additional
+# permissions described in the Autoconf Configure Script Exception,
+# version 3.0, as published by the Free Software Foundation.
+#
+# You should have received a copy of the GNU General Public License
+# and a copy of the Autoconf Configure Script Exception along with
+# this program; see the files COPYINGv3 and COPYING.EXCEPTION
+# respectively.  If not, see <http://www.gnu.org/licenses/>.
+
+# Written by David MacKenzie, with help from
+# Franc,ois Pinard, Karl Berry, Richard Pixley, Ian Lance Taylor,
+# Roland McGrath, Noah Friedman, david d zuhn, and many others.
+
+
+# Table of Contents:
+#
+# Preamble
+#
+# 0. Utility macros
+#
+# 1. Language selection
+#    and routines to produce programs in a given language.
+#
+# 2. Producing programs in a given language.
+#
+# 3. Looking for a compiler
+#    And possibly the associated preprocessor.
+#
+# 4. Compilers' characteristics.
+
+# AC_FC_PP_SRCEXT(EXT, [ACTION-IF-SUCCESS], [ACTION-IF-FAILURE])
+# --------------------------------------------------------------
+# Like AC_FC_SRCEXT, set the source-code extension used in Fortran (FC) tests
+# to EXT (which defaults to f).  Also, look for any necessary additional
+# FCFLAGS needed to allow this extension for preprocessed Fortran, and store
+# them in the output variable FCFLAGS_<EXT> (e.g. FCFLAGS_f90 for EXT=f90).
+# If successful, call ACTION-IF-SUCCESS.  If unable to compile preprocessed
+# source code with EXT, call ACTION-IF-FAILURE, which defaults to failing with
+# an error message.
+#
+# Some compilers allow preprocessing with either a Fortran preprocessor or
+# with the C preprocessor (cpp).  Prefer the Fortran preprocessor, to deal
+# correctly with continuation lines, `//' (not a comment), and preserve white
+# space (for fixed form).
+#
+# (The flags for the current source-code extension, if any, are stored in
+# $ac_fcflags_srcext and used automatically in subsequent autoconf tests.)
+#
+# For ordinary extensions like f90, etcetera, the modified FCFLAGS
+# are needed for IBM's xlf*.  Also, for Intel's ifort compiler, the
+# $FCFLAGS_<EXT> variable *must* go immediately before the source file on the
+# command line, unlike other $FCFLAGS.  Ugh.
+#
+# Known extensions that enable preprocessing by default, and flags to force it:
+# GNU: .F .F90 .F95 .F03 .F08, -cpp for most others,
+#      -x f77-cpp-input for .f77 .F77; -x f95-cpp-input for gfortran < 4.4
+# SGI: .F .F90, -ftpp or -cpp for .f .f90, -E write preproc to stdout
+#      -macro_expand enable macro expansion everywhere (with -ftpp)
+#      -P preproc only, save in .i, no #line's
+# SUN: .F .F95, -fpp for others; -xpp={fpp,cpp} for preprocessor selection
+#      -F preprocess only (save in lowercase extension)
+# IBM: .F .F77 .F90 .F95 .F03, -qsuffix=cpp=EXT for extension .EXT to invoke cpp
+#      -WF,-qnofpp -WF,-qfpp=comment:linecont:nocomment:nolinecont
+#      -WF,-qlanglvl=classic or not -qnoescape (trigraph problems)
+#      -d no #line in output, -qnoobject for preprocessing only (output in .f)
+#      -q{no,}ppsuborigarg substitute original macro args before expansion
+# HP:  .F, +cpp={yes|no|default} use cpp, -cpp, +cpp_keep save in .i/.i90
+# PGI: -Mpreprocess
+# Absoft: .F .FOR .F90 .F95, -cpp for others
+# Cray: .F .F90 .FTN, -e Z for others; -F enable macro expansion everywhere
+# Intel: .F .F90, -fpp for others, but except for .f and .f90, -Tf may also be
+#        needed right before the source file name
+# PathScale: .F .F90 .F95, -ftpp or -cpp for .f .f90 .f95
+#         -macro_expand for expansion everywhere, -P for no #line in output
+# Lahey: .F .FOR .F90 .F95, -Cpp
+# NAGWare: .F .F90 .F95, .ff .ff90 .ff95 (new), -fpp for others
+# Compaq/Tru64: .F .F90, -cpp, -P keep .i file, -P keep .i file
+# f2c: .F, -cpp
+# g95: .F .FOR .F90 .F95 .F03, -cpp -no-cpp, -E for stdout
+AC_DEFUN([AC_FC_PP_SRCEXT],
+[AC_LANG_PUSH(Fortran)dnl
+AC_CACHE_CHECK([for Fortran flag to compile preprocessed .$1 files],
+		ac_cv_fc_pp_srcext_$1,
+[ac_ext=$1
+ac_fcflags_pp_srcext_save=$ac_fcflags_srcext
+ac_fcflags_srcext=
+ac_cv_fc_pp_srcext_$1=unknown
+case $ac_ext in #(
+  [[fF]]77) ac_try=f77-cpp-input;; #(
+  *) ac_try=f95-cpp-input;;
+esac
+for ac_flag in none -ftpp -fpp -Tf "-fpp -Tf" -xpp=fpp -Mpreprocess "-e Z" \
+               -cpp -xpp=cpp -qsuffix=cpp=$1 "-x $ac_try" +cpp -Cpp; do
+  test "x$ac_flag" != xnone && ac_fcflags_srcext="$ac_flag"
+  AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[
+#if 0
+#include <ac_nonexistent.h>
+      choke me
+#endif]])],
+    [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[
+#if 1
+#include <ac_nonexistent.h>
+      choke me
+#endif]])],
+       [],
+       [ac_cv_fc_pp_srcext_$1=$ac_flag; break])])
+done
+rm -f conftest.$ac_objext conftest.$1
+ac_fcflags_srcext=$ac_fcflags_pp_srcext_save
+])
+if test "x$ac_cv_fc_pp_srcext_$1" = xunknown; then
+  m4_default([$3],
+             [AC_MSG_ERROR([Fortran could not compile preprocessed .$1 files])])
+else
+  ac_fc_srcext=$1
+  if test "x$ac_cv_fc_pp_srcext_$1" = xnone; then
+    ac_fcflags_srcext=""
+    FCFLAGS_[]$1[]=""
+  else
+    ac_fcflags_srcext=$ac_cv_fc_pp_srcext_$1
+    FCFLAGS_[]$1[]=$ac_cv_fc_pp_srcext_$1
+  fi
+  AC_SUBST(FCFLAGS_[]$1)
+  $2
+fi
+AC_LANG_POP(Fortran)dnl
+])# AC_FC_PP_SRCEXT
+
+# AC_FC_PP_DEFINE([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# -------------------------------------------------------------------
+# Find a flag to specify defines for preprocessed Fortran.  Not all
+# Fortran compilers use -D.  Substitute FC_DEFINE with the result and
+# call ACTION-IF-SUCCESS (defaults to nothing) if successful, and
+# ACTION-IF-FAILURE (defaults to failing with an error message) if not.
+#
+# Known flags:
+# IBM: -WF,-D
+# Lahey/Fujitsu: -Wp,-D     older versions???
+# f2c: -D or -Wc,-D
+# others: -D
+AC_DEFUN([AC_FC_PP_DEFINE],
+[AC_LANG_PUSH([Fortran])dnl
+ac_fc_pp_define_srcext_save=$ac_fc_srcext
+AC_FC_PP_SRCEXT([F])
+AC_CACHE_CHECK([how to define symbols for preprocessed Fortran],
+  [ac_cv_fc_pp_define],
+[ac_fc_pp_define_srcext_save=$ac_fc_srcext
+ac_cv_fc_pp_define=unknown
+ac_fc_pp_define_FCFLAGS_save=$FCFLAGS
+for ac_flag in -D -WF,-D -Wp,-D -Wc,-D
+do
+  FCFLAGS="$ac_fc_pp_define_FCFLAGS_save ${ac_flag}FOOBAR ${ac_flag}ZORK=42"
+  AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[
+#ifndef FOOBAR
+      choke me
+#endif
+#if ZORK != 42
+      choke me
+#endif]])],
+    [ac_cv_fc_pp_define=$ac_flag])
+  test x"$ac_cv_fc_pp_define" != xunknown && break
+done
+FCFLAGS=$ac_fc_pp_define_FCFLAGS_save
+])
+ac_fc_srcext=$ac_fc_pp_define_srcext_save
+if test "x$ac_cv_fc_pp_define" = xunknown; then
+  FC_DEFINE=
+  m4_default([$2],
+	     [AC_MSG_ERROR([Fortran does not allow to define preprocessor symbols], 77)])
+else
+  FC_DEFINE=$ac_cv_fc_pp_define
+  $1
+fi
+AC_SUBST([FC_DEFINE])dnl
+AC_LANG_POP([Fortran])dnl
+])
+
+
+# AC_FC_FREEFORM([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ------------------------------------------------------------------
+# Look for a compiler flag to make the Fortran (FC) compiler accept
+# free-format source code, and adds it to FCFLAGS.  Call
+# ACTION-IF-SUCCESS (defaults to nothing) if successful (i.e. can
+# compile code using new extension) and ACTION-IF-FAILURE (defaults to
+# failing with an error message) if not.  (Defined via DEFUN_ONCE to
+# prevent flag from being added to FCFLAGS multiple times.)
+#
+# The known flags are:
+#        -ffree-form: GNU g77, gfortran, g95
+#         -FR, -free: Intel compiler (icc, ecc, ifort)
+#              -free: Compaq compiler (fort), Sun compiler (f95)
+#             -qfree: IBM compiler (xlf)
+# -Mfree, -Mfreeform: Portland Group compiler
+#          -freeform: SGI compiler
+#        -8, -f free: Absoft Fortran
+#       +source=free: HP Fortran
+#    (-)-nfix, -Free: Lahey/Fujitsu Fortran
+#              -free: NAGWare
+#         -f, -Wf,-f: f2c (but only a weak form of "free-form" and long lines)
+# We try to test the "more popular" flags first, by some prejudiced
+# notion of popularity.
+AC_DEFUN_ONCE([AC_FC_FREEFORM],
+[AC_LANG_PUSH([Fortran])dnl
+AC_CACHE_CHECK([for Fortran flag needed to accept free-form source],
+	       [ac_cv_fc_freeform],
+[ac_cv_fc_freeform=unknown
+ac_fc_freeform_FCFLAGS_save=$FCFLAGS
+for ac_flag in none -ffree-form -FR -free -qfree -Mfree -Mfreeform \
+	       -freeform "-f free" -8 +source=free -nfix --nfix -Free
+do
+  test "x$ac_flag" != xnone && FCFLAGS="$ac_fc_freeform_FCFLAGS_save $ac_flag"
+dnl Use @&t@ below to ensure that editors don't turn 8+ spaces into tab.
+  AC_COMPILE_IFELSE([[
+  program freeform
+       ! FIXME: how to best confuse non-freeform compilers?
+       print *, 'Hello ', &
+     @&t@     'world.'
+       end]],
+		    [ac_cv_fc_freeform=$ac_flag; break])
+done
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+FCFLAGS=$ac_fc_freeform_FCFLAGS_save
+])
+if test "x$ac_cv_fc_freeform" = xunknown; then
+  m4_default([$2],
+	     [AC_MSG_ERROR([Fortran does not accept free-form source], 77)])
+else
+  if test "x$ac_cv_fc_freeform" != xnone; then
+    FCFLAGS="$FCFLAGS $ac_cv_fc_freeform"
+  fi
+  $1
+fi
+AC_LANG_POP([Fortran])dnl
+])# AC_FC_FREEFORM
+
+
+# AC_FC_FIXEDFORM([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ------------------------------------------------------------------
+# Look for a compiler flag to make the Fortran (FC) compiler accept
+# fixed-format source code, and adds it to FCFLAGS.  Call
+# ACTION-IF-SUCCESS (defaults to nothing) if successful (i.e. can
+# compile code using new extension) and ACTION-IF-FAILURE (defaults to
+# failing with an error message) if not.  (Defined via DEFUN_ONCE to
+# prevent flag from being added to FCFLAGS multiple times.)
+#
+# The known flags are:
+#       -ffixed-form: GNU g77, gfortran, g95
+#             -fixed: Intel compiler (ifort), Sun compiler (f95)
+#            -qfixed: IBM compiler (xlf*)
+#            -Mfixed: Portland Group compiler
+#         -fixedform: SGI compiler
+#           -f fixed: Absoft Fortran
+#      +source=fixed: HP Fortran
+#    (-)-fix, -Fixed: Lahey/Fujitsu Fortran
+#             -fixed: NAGWare
+# Since compilers may accept fixed form based on file name extension,
+# but users may want to use it with others as well, call AC_FC_SRCEXT
+# with the respective source extension before calling this macro.
+AC_DEFUN_ONCE([AC_FC_FIXEDFORM],
+[AC_LANG_PUSH([Fortran])dnl
+AC_CACHE_CHECK([for Fortran flag needed to accept fixed-form source],
+	       [ac_cv_fc_fixedform],
+[ac_cv_fc_fixedform=unknown
+ac_fc_fixedform_FCFLAGS_save=$FCFLAGS
+for ac_flag in none -ffixed-form -fixed -qfixed -Mfixed -fixedform "-f fixed" \
+	       +source=fixed -fix --fix -Fixed
+do
+  test "x$ac_flag" != xnone && FCFLAGS="$ac_fc_fixedform_FCFLAGS_save $ac_flag"
+  AC_COMPILE_IFELSE([[
+C     This comment should confuse free-form compilers.
+      program main
+      end]],
+		    [ac_cv_fc_fixedform=$ac_flag; break])
+done
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+FCFLAGS=$ac_fc_fixedform_FCFLAGS_save
+])
+if test "x$ac_cv_fc_fixedform" = xunknown; then
+  m4_default([$2],
+	     [AC_MSG_ERROR([Fortran does not accept fixed-form source], 77)])
+else
+  if test "x$ac_cv_fc_fixedform" != xnone; then
+    FCFLAGS="$FCFLAGS $ac_cv_fc_fixedform"
+  fi
+  $1
+fi
+AC_LANG_POP([Fortran])dnl
+])# AC_FC_FIXEDFORM
+
+
+# AC_FC_LINE_LENGTH([LENGTH], [ACTION-IF-SUCCESS],
+#		    [ACTION-IF-FAILURE = FAILURE])
+# ------------------------------------------------
+# Look for a compiler flag to make the Fortran (FC) compiler accept long lines
+# in the current (free- or fixed-format) source code, and adds it to FCFLAGS.
+# The optional LENGTH may be 80, 132 (default), or `unlimited' for longer
+# lines.  Note that line lengths above 254 columns are not portable, and some
+# compilers (hello ifort) do not accept more than 132 columns at least for
+# fixed format.  Call ACTION-IF-SUCCESS (defaults to nothing) if successful
+# (i.e. can compile code using new extension) and ACTION-IF-FAILURE (defaults
+# to failing with an error message) if not.  (Defined via DEFUN_ONCE to
+# prevent flag from being added to FCFLAGS multiple times.)
+# You should call AC_FC_FREEFORM or AC_FC_FIXEDFORM to set the desired format
+# prior to using this macro.
+#
+# The known flags are:
+# -f{free,fixed}-line-length-N with N 72, 80, 132, or 0 or none for none.
+# -ffree-line-length-none: GNU gfortran
+# -ffree-line-length-huge: g95 (also -ffixed-line-length-N as above)
+#       -qfixed=132 80 72: IBM compiler (xlf)
+#                -Mextend: Cray
+#            -132 -80 -72: Intel compiler (ifort)
+#                          Needs to come before -extend_source because ifort
+#                          accepts that as well with an optional parameter and
+#                          doesn't fail but only warns about unknown arguments.
+#          -extend_source: SGI compiler
+#  -W, -WNN (132, 80, 72): Absoft Fortran
+#     +es, +extend_source: HP Fortran (254 in either form, default is 72 fixed,
+#			   132 free)
+#            -w, (-)-wide: Lahey/Fujitsu Fortran (255 cols in fixed form)
+#                      -e: Sun Fortran compiler (132 characters)
+#                    -132: NAGWare
+#         -72, -f, -Wf,-f: f2c (a weak form of "free-form" and long lines).
+#                  /XLine: Open Watcom
+AC_DEFUN_ONCE([AC_FC_LINE_LENGTH],
+[AC_LANG_PUSH([Fortran])dnl
+m4_case(m4_default([$1], [132]),
+  [unlimited], [ac_fc_line_len_string=unlimited
+	               ac_fc_line_len=0
+                       ac_fc_line_length_test='
+      subroutine longer_than_132(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,'\
+'arg9,arg10,arg11,arg12,arg13,arg14,arg15,arg16,arg17,arg18,arg19)'],
+  [132],            [ac_fc_line_len=132
+		       ac_fc_line_length_test='
+      subroutine longer_than_80(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,'\
+'arg10)'],
+  [80],             [ac_fc_line_len=80
+		       ac_fc_line_length_test='
+      subroutine longer_than_72(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9)'],
+  [m4_warning([Invalid length argument `$1'])])
+: ${ac_fc_line_len_string=$ac_fc_line_len}
+AC_CACHE_CHECK(
+[for Fortran flag needed to accept $ac_fc_line_len_string column source lines],
+	       [ac_cv_fc_line_length],
+[ac_cv_fc_line_length=unknown
+ac_fc_line_length_FCFLAGS_save=$FCFLAGS
+for ac_flag in none \
+	       -ffree-line-length-none -ffixed-line-length-none \
+	       -ffree-line-length-huge \
+	       -ffree-line-length-$ac_fc_line_len \
+	       -ffixed-line-length-$ac_fc_line_len \
+	       -qfixed=$ac_fc_line_len -Mextend \
+	       -$ac_fc_line_len -extend_source \
+	       -W$ac_fc_line_len -W +extend_source +es -wide --wide -w -e \
+               -f -Wf,-f -xline
+do
+  test "x$ac_flag" != xnone && FCFLAGS="$ac_fc_line_length_FCFLAGS_save $ac_flag"
+  AC_COMPILE_IFELSE([[$ac_fc_line_length_test
+      end subroutine]],
+		    [ac_cv_fc_line_length=$ac_flag; break])
+done
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+FCFLAGS=$ac_fc_line_length_FCFLAGS_save
+])
+if test "x$ac_cv_fc_line_length" = xunknown; then
+  m4_default([$3],
+	     [AC_MSG_ERROR([Fortran does not accept long source lines], 77)])
+else
+  if test "x$ac_cv_fc_line_length" != xnone; then
+    FCFLAGS="$FCFLAGS $ac_cv_fc_line_length"
+  fi
+  $2
+fi
+AC_LANG_POP([Fortran])dnl
+])# AC_FC_LINE_LENGTH
+
+
+# AC_FC_CHECK_BOUNDS([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ----------------------------------------------------------------------
+# Look for a compiler flag to turn on array bounds checking for the
+# Fortran (FC) compiler, and adds it to FCFLAGS.  Call
+# ACTION-IF-SUCCESS (defaults to nothing) if successful (i.e. can
+# compile code using new extension) and ACTION-IF-FAILURE (defaults to
+# failing with an error message) if not.  (Defined via DEFUN_ONCE to
+# prevent flag from being added to FCFLAGS multiple times.)
+#
+# The known flags are:
+# -fcheck=all, -fbounds-check: gfortran
+#     -fbounds-check: g77, g95
+# -CB, -check bounds: Intel compiler (icc, ecc, ifort)
+#                 -C: Sun/Oracle compiler (f95)
+#        -C, -qcheck: IBM compiler (xlf)
+#           -Mbounds: Portland Group compiler
+#       -C ,-Mbounds: Cray
+#  -C, -check_bounds: SGI compiler
+# -check_bounds, +check=all: HP Fortran
+#        -C, -Rb -Rc: Absoft (-Rb: array boundaries, -Rc: array conformance)
+# --chk e,s -chk (e,s): Lahey
+#          -C -C=all: NAGWare
+# -C, -ffortran-bounds-check: PathScale pathf90
+#                 -C: f2c
+#            -BOunds: Open Watcom
+AC_DEFUN_ONCE([AC_FC_CHECK_BOUNDS],
+[AC_LANG_PUSH([Fortran])dnl
+AC_CACHE_CHECK([for Fortran flag to enable array-bounds checking],
+               [ac_cv_fc_check_bounds],
+[ac_cv_fc_check_bounds=unknown
+ac_fc_check_bounds_FCFLAGS_save=$FCFLAGS
+for ac_flag in -fcheck=bounds -fbounds-check -check_bounds -Mbounds -qcheck \
+               '-check bounds' +check=all --check '-Rb -Rc' -CB -C=all -C \
+               -ffortran-bounds-check "--chk e,s" "-chk e -chk s" -bounds
+do
+  FCFLAGS="$ac_fc_check_bounds_FCFLAGS_save $ac_flag"
+  # We should be able to link a correct program.
+  AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
+    [AC_LINK_IFELSE([[
+      subroutine sub(a)
+      integer a(:)
+      a(8) = 0
+      end subroutine
+
+      program main
+      integer a(1:7)
+      interface
+         subroutine sub(a)
+         integer a(:)
+         end subroutine
+      end interface
+
+      call sub(a)
+      end program]],
+       [# If we can run the program, require failure at run time.
+	# In cross-compiling mode, we rely on the compiler not accepting
+	# unknown options.
+	AS_IF([test "$cross_compiling" = yes],
+	  [ac_cv_fc_check_bounds=$ac_flag; break],
+	  [AS_IF([_AC_DO_TOKENS(./conftest$ac_exeext)],
+	     [],
+	     [ac_cv_fc_check_bounds=$ac_flag; break])])])])
+done
+rm -f conftest$ac_exeext conftest.err conftest.$ac_objext conftest.$ac_ext
+FCFLAGS=$ac_fc_check_bounds_FCFLAGS_save
+])
+if test "x$ac_cv_fc_check_bounds" = xunknown; then
+  m4_default([$2],
+             [AC_MSG_ERROR([no Fortran flag for bounds checking found], 77)])
+else
+  if test "x$ac_cv_fc_check_bounds" != xnone; then
+    FCFLAGS="$FCFLAGS $ac_cv_fc_check_bounds"
+  fi
+  $1
+fi
+AC_LANG_POP([Fortran])dnl
+])# AC_FC_CHECK_BOUNDS
+
+
+# _AC_FC_IMPLICIT_NONE([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ------------------------------------------------------------------------
+# Look for a flag to disallow implicit declarations, and add it to FCFLAGS.
+# Call ACTION-IF-SUCCESS (defaults to nothing) if successful and
+# ACTION-IF-FAILURE (defaults to failing with an error message) if not.
+#
+# Known flags:
+# GNU gfortran, g95: -fimplicit-none, g77: -Wimplicit
+# Intel: -u, -implicitnone; might also need '-warn errors' to turn into error.
+# Sun/Oracle: -u
+# HP: +implicit_none
+# IBM: -u, -qundef
+# SGI: -u
+# Compaq: -u, -warn declarations
+# NAGWare: -u
+# Lahey: -in, --in, -AT
+# Cray: -Mdclchk -e I
+# PGI: -Mcdlchk
+# f2c: -u
+AC_DEFUN([_AC_FC_IMPLICIT_NONE],
+[_AC_FORTRAN_ASSERT()dnl
+AC_CACHE_CHECK([for flag to disallow _AC_LANG implicit declarations],
+               [ac_cv_[]_AC_LANG_ABBREV[]_implicit_none],
+[ac_cv_[]_AC_LANG_ABBREV[]_implicit_none=unknown
+ac_fc_implicit_none_[]_AC_LANG_PREFIX[]FLAGS_save=$[]_AC_LANG_PREFIX[]FLAGS
+for ac_flag in none -fimplicit-none -u -Wimplicit -implicitnone +implicit_none \
+               -qundef "-warn declarations" -in --in -AT "-e I" -Mdclchk \
+               "-u -warn errors"
+do
+  if test "x$ac_flag" != xnone; then
+    _AC_LANG_PREFIX[]FLAGS="$ac_fc_implicit_none_[]_AC_LANG_PREFIX[]FLAGS_save $ac_flag"
+  fi
+  AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [])],
+    [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [[
+      i = 0
+      print *, i]])],
+       [],
+       [ac_cv_[]_AC_LANG_ABBREV[]_implicit_none=$ac_flag; break])])
+done
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+_AC_LANG_PREFIX[]FLAGS=$ac_fc_implicit_none_[]_AC_LANG_PREFIX[]FLAGS_save
+])
+if test "x$ac_cv_[]_AC_LANG_ABBREV[]_implicit_none" = xunknown; then
+  m4_default([$3],
+    [AC_MSG_ERROR([no Fortran flag to disallow implicit declarations found], 77)])
+else
+  if test "x$ac_cv_[]_AC_LANG_ABBREV[]_implicit_none" != xnone; then
+    _AC_LANG_PREFIX[]FLAGS="$_AC_LANG_PREFIX[]FLAGS $ac_cv_[]_AC_LANG_ABBREV[]_implicit_none"
+  fi
+  $2
+fi
+])# _AC_FC_IMPLICIT_NONE
+
+
+# AC_F77_IMPLICIT_NONE([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ------------------------------------------------------------------------
+AC_DEFUN([AC_F77_IMPLICIT_NONE],
+[AC_LANG_PUSH([Fortran 77])dnl
+_AC_FC_IMPLICIT_NONE($@)
+AC_LANG_POP([Fortran 77])dnl
+])# AC_F77_IMPLICIT_NONE
+
+
+# AC_FC_IMPLICIT_NONE([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# -----------------------------------------------------------------------
+AC_DEFUN([AC_FC_IMPLICIT_NONE],
+[AC_LANG_PUSH([Fortran])dnl
+_AC_FC_IMPLICIT_NONE($@)
+AC_LANG_POP([Fortran])dnl
+])# AC_FC_IMPLICIT_NONE
+
+
+# AC_FC_MODULE_EXTENSION
+# ----------------------
+# Find the Fortran 90 module file extension.  The module extension is stored
+# in the variable FC_MODEXT and empty if it cannot be determined.  The result
+# or "unknown" is cached in the cache variable ac_cv_fc_module_ext.
+AC_DEFUN([AC_FC_MODULE_EXTENSION],
+[AC_CACHE_CHECK([Fortran 90 module extension], [ac_cv_fc_module_ext],
+[AC_LANG_PUSH(Fortran)
+mkdir conftest.dir
+cd conftest.dir
+ac_cv_fc_module_ext=unknown
+AC_COMPILE_IFELSE([[
+      module conftest_module
+      contains
+      subroutine conftest_routine
+      write(*,'(a)') 'gotcha!'
+      end subroutine
+      end module]],
+  [ac_cv_fc_module_ext=`ls | sed -n 's,conftest_module\.,,p'`
+   if test x$ac_cv_fc_module_ext = x; then
+dnl Some F90 compilers use upper case characters for the module file name.
+     ac_cv_fc_module_ext=`ls | sed -n 's,CONFTEST_MODULE\.,,p'`
+   fi])
+cd ..
+rm -rf conftest.dir
+AC_LANG_POP(Fortran)
+])
+FC_MODEXT=$ac_cv_fc_module_ext
+if test "$FC_MODEXT" = unknown; then
+  FC_MODEXT=
+fi
+AC_SUBST([FC_MODEXT])dnl
+])
+
+
+# AC_FC_MODULE_FLAG([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ---------------------------------------------------------------------
+# Find a flag to include Fortran 90 modules from another directory.
+# If successful, run ACTION-IF-SUCCESS (defaults to nothing), otherwise
+# run ACTION-IF-FAILURE (defaults to failing with an error message).
+# The module flag is cached in the ac_cv_fc_module_flag variable.
+# It may contain significant trailing whitespace.
+#
+# Known flags:
+# gfortran: -Idir, -I dir (-M dir, -Mdir (deprecated), -Jdir for writing)
+# g95: -I dir (-fmod=dir for writing)
+# SUN: -Mdir, -M dir (-moddir=dir for writing;
+#                     -Idir for includes is also searched)
+# HP: -Idir, -I dir (+moddir=dir for writing)
+# IBM: -Idir (-qmoddir=dir for writing)
+# Intel: -Idir -I dir (-mod dir for writing)
+# Absoft: -pdir
+# Lahey: -Idir (-Mdir or -mod dir for writing)
+# Cray: -module dir, -p dir (-J dir for writing)
+#       -e m is needed to enable writing .mod files at all
+# Compaq: -Idir
+# NAGWare: -I dir
+# PathScale: -I dir  (but -module dir is looked at first)
+# Portland: -module dir (first -module also names dir for writing)
+# Fujitsu: -Am -Idir (-Mdir for writing is searched first, then '.', then -I)
+#                    (-Am indicates how module information is saved)
+AC_DEFUN([AC_FC_MODULE_FLAG],[
+AC_CACHE_CHECK([Fortran 90 module inclusion flag], [ac_cv_fc_module_flag],
+[AC_LANG_PUSH([Fortran])
+ac_cv_fc_module_flag=unknown
+mkdir conftest.dir
+cd conftest.dir
+AC_COMPILE_IFELSE([[
+      module conftest_module
+      contains
+      subroutine conftest_routine
+      write(*,'(a)') 'gotcha!'
+      end subroutine
+      end module]],
+  # For Lahey -M will also write module and object files to that directory
+  # make it read-only so that lahey fails over to -I   
+  [chmod -w .
+   cd ..
+   ac_fc_module_flag_FCFLAGS_save=$FCFLAGS
+   # Flag ordering is significant for gfortran and Sun.
+   for ac_flag in -M -I '-I ' '-M ' -p '-mod ' '-module ' '-Am -I'; do
+     # Add the flag twice to prevent matching an output flag.
+     FCFLAGS="$ac_fc_module_flag_FCFLAGS_save ${ac_flag}conftest.dir ${ac_flag}conftest.dir"
+     AC_COMPILE_IFELSE([[
+      module conftest_main
+      use conftest_module
+      contains
+      subroutine conftest
+      call conftest_routine
+      end subroutine
+      end module]],
+       [ac_cv_fc_module_flag="$ac_flag"])
+     if test "$ac_cv_fc_module_flag" != unknown; then
+       break
+     fi
+   done
+   FCFLAGS=$ac_fc_module_flag_FCFLAGS_save
+])
+chmod +w conftest.dir
+rm -rf conftest.dir
+AC_LANG_POP([Fortran])
+])
+if test "$ac_cv_fc_module_flag" != unknown; then
+  FC_MODINC=$ac_cv_fc_module_flag
+  $1
+else
+  FC_MODINC=
+  m4_default([$2],
+    [AC_MSG_ERROR([unable to find compiler flag for module search path])])
+fi
+AC_SUBST([FC_MODINC])
+# Ensure trailing whitespace is preserved in a Makefile.
+AC_SUBST([ac_empty], [""])
+AC_CONFIG_COMMANDS_PRE([case $FC_MODINC in #(
+  *\ ) FC_MODINC=$FC_MODINC'${ac_empty}' ;;
+esac])dnl
+])
+
+
+# AC_FC_MODULE_OUTPUT_FLAG([ACTION-IF-SUCCESS], [ACTION-IF-FAILURE = FAILURE])
+# ----------------------------------------------------------------------------
+# Find a flag to write Fortran 90 module information to another directory.
+# If successful, run ACTION-IF-SUCCESS (defaults to nothing), otherwise
+# run ACTION-IF-FAILURE (defaults to failing with an error message).
+# The module flag is cached in the ac_cv_fc_module_output_flag variable.
+# It may contain significant trailing whitespace.
+#
+# For known flags, see the documentation of AC_FC_MODULE_FLAG above.
+AC_DEFUN([AC_FC_MODULE_OUTPUT_FLAG],[
+AC_CACHE_CHECK([Fortran 90 module output flag], [ac_cv_fc_module_output_flag],
+[AC_LANG_PUSH([Fortran])
+mkdir conftest.dir conftest.dir/sub
+cd conftest.dir
+ac_cv_fc_module_output_flag=unknown
+ac_fc_module_output_flag_FCFLAGS_save=$FCFLAGS
+# Flag ordering is significant: put flags late which some compilers use
+# for the search path.
+for ac_flag in -J '-J ' -fmod= -moddir= +moddir= -qmoddir= '-mod ' \
+	      '-module ' -M '-Am -M' '-e m -J '; do
+  FCFLAGS="$ac_fc_module_output_flag_FCFLAGS_save ${ac_flag}sub"
+  AC_COMPILE_IFELSE([[
+      module conftest_module
+      contains
+      subroutine conftest_routine
+      write(*,'(a)') 'gotcha!'
+      end subroutine
+      end module]],
+    [cd sub
+     AC_COMPILE_IFELSE([[
+      program main
+      use conftest_module
+      call conftest_routine
+      end program]],
+       [ac_cv_fc_module_output_flag="$ac_flag"])
+     cd ..
+     if test "$ac_cv_fc_module_output_flag" != unknown; then
+       break
+     fi])
+done
+FCFLAGS=$ac_fc_module_output_flag_FCFLAGS_save
+cd ..
+rm -rf conftest.dir
+AC_LANG_POP([Fortran])
+])
+if test "$ac_cv_fc_module_output_flag" != unknown; then
+  FC_MODOUT=$ac_cv_fc_module_output_flag
+  $1
+else
+  FC_MODOUT=
+  m4_default([$2],
+    [AC_MSG_ERROR([unable to find compiler flag to write module information to])])
+fi
+AC_SUBST([FC_MODOUT])
+# Ensure trailing whitespace is preserved in a Makefile.
+AC_SUBST([ac_empty], [""])
+AC_CONFIG_COMMANDS_PRE([case $FC_MODOUT in #(
+  *\ ) FC_MODOUT=$FC_MODOUT'${ac_empty}' ;;
+esac])dnl
+])
+
+# _AC_FC_LIBRARY_LDFLAGS
+# ----------------------
+#
+# Determine the linker flags (e.g. "-L" and "-l") for the Fortran
+# intrinsic and runtime libraries that are required to successfully
+# link a Fortran program or shared library.  The output variable
+# FLIBS/FCLIBS is set to these flags.
+#
+# This macro is intended to be used in those situations when it is
+# necessary to mix, e.g. C++ and Fortran, source code into a single
+# program or shared library.
+#
+# For example, if object files from a C++ and Fortran compiler must
+# be linked together, then the C++ compiler/linker must be used for
+# linking (since special C++-ish things need to happen at link time
+# like calling global constructors, instantiating templates, enabling
+# exception support, etc.).
+#
+# However, the Fortran intrinsic and runtime libraries must be
+# linked in as well, but the C++ compiler/linker doesn't know how to
+# add these Fortran libraries.  Hence, the macro
+# "AC_F77_LIBRARY_LDFLAGS" was created to determine these Fortran
+# libraries.
+#
+# This macro was packaged in its current form by Matthew D. Langston.
+# However, nearly all of this macro came from the "OCTAVE_FLIBS" macro
+# in "octave-2.0.13/aclocal.m4", and full credit should go to John
+# W. Eaton for writing this extremely useful macro.  Thank you John.
+AC_DEFUN([_AC_FC_LIBRARY_LDFLAGS],
+[_AC_FORTRAN_ASSERT()dnl
+_AC_PROG_FC_V
+AC_CACHE_CHECK([for _AC_LANG libraries of $[]_AC_FC[]], ac_cv_[]_AC_LANG_ABBREV[]_libs,
+[if test "x$[]_AC_LANG_PREFIX[]LIBS" != "x"; then
+  ac_cv_[]_AC_LANG_ABBREV[]_libs="$[]_AC_LANG_PREFIX[]LIBS" # Let the user override the test.
+else
+
+_AC_PROG_FC_V_OUTPUT
+
+ac_cv_[]_AC_LANG_ABBREV[]_libs=
+
+# Save positional arguments (if any)
+ac_save_positional="$[@]"
+
+set X $ac_[]_AC_LANG_ABBREV[]_v_output
+while test $[@%:@] != 1; do
+  shift
+  ac_arg=$[1]
+  case $ac_arg in
+	[[\\/]]*.a | ?:[[\\/]]*.a)
+	  _AC_LIST_MEMBER_IF($ac_arg, $ac_cv_[]_AC_LANG_ABBREV[]_libs, ,
+	      ac_cv_[]_AC_LANG_ABBREV[]_libs="$ac_cv_[]_AC_LANG_ABBREV[]_libs $ac_arg")
+	  ;;
+	-bI:*)
+	  _AC_LIST_MEMBER_IF($ac_arg, $ac_cv_[]_AC_LANG_ABBREV[]_libs, ,
+	     [_AC_LINKER_OPTION([$ac_arg], ac_cv_[]_AC_LANG_ABBREV[]_libs)])
+	  ;;
+	  # Ignore these flags.
+	-lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \
+	  |-LANG:=* | -LIST:* | -LNO:* | -link | -list | -lnuma )
+	  ;;
+	-lkernel32)
+	  test x"$CYGWIN" != xyes && ac_cv_[]_AC_LANG_ABBREV[]_libs="$ac_cv_[]_AC_LANG_ABBREV[]_libs $ac_arg"
+	  ;;
+	-[[LRuYz]])
+	  # These flags, when seen by themselves, take an argument.
+	  # We remove the space between option and argument and re-iterate
+	  # unless we find an empty arg or a new option (starting with -)
+	  case $[2] in
+	     "" | -*);;
+	     *)
+		ac_arg="$ac_arg$[2]"
+		shift; shift
+		set X $ac_arg "$[@]"
+		;;
+	  esac
+	  ;;
+	-YP,*)
+	  for ac_j in `AS_ECHO(["$ac_arg"]) | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do
+	    _AC_LIST_MEMBER_IF($ac_j, $ac_cv_[]_AC_LANG_ABBREV[]_libs, ,
+			       [ac_arg="$ac_arg $ac_j"
+			       ac_cv_[]_AC_LANG_ABBREV[]_libs="$ac_cv_[]_AC_LANG_ABBREV[]_libs $ac_j"])
+	  done
+	  ;;
+	-[[lLR]]*)
+	  _AC_LIST_MEMBER_IF($ac_arg, $ac_cv_[]_AC_LANG_ABBREV[]_libs, ,
+			     ac_cv_[]_AC_LANG_ABBREV[]_libs="$ac_cv_[]_AC_LANG_ABBREV[]_libs $ac_arg")
+	  ;;
+	-zallextract*| -zdefaultextract)
+	  ac_cv_[]_AC_LANG_ABBREV[]_libs="$ac_cv_[]_AC_LANG_ABBREV[]_libs $ac_arg"
+	  ;;
+	  # Ignore everything else.
+  esac
+done
+# restore positional arguments
+set X $ac_save_positional; shift
+
+# We only consider "LD_RUN_PATH" on Solaris systems.  If this is seen,
+# then we insist that the "run path" must be an absolute path (i.e. it
+# must begin with a "/").
+case `(uname -sr) 2>/dev/null` in
+   "SunOS 5"*)
+      ac_ld_run_path=`AS_ECHO(["$ac_[]_AC_LANG_ABBREV[]_v_output"]) |
+			sed -n 's,^.*LD_RUN_PATH *= *\(/[[^ ]]*\).*$,-R\1,p'`
+      test "x$ac_ld_run_path" != x &&
+	_AC_LINKER_OPTION([$ac_ld_run_path], ac_cv_[]_AC_LANG_ABBREV[]_libs)
+      ;;
+esac
+fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x"
+])
+[]_AC_LANG_PREFIX[]LIBS="$ac_cv_[]_AC_LANG_ABBREV[]_libs"
+AC_SUBST([]_AC_LANG_PREFIX[]LIBS)
+])# _AC_FC_LIBRARY_LDFLAGS
+
+
+# AC_F77_LIBRARY_LDFLAGS
+# ----------------------
+AC_DEFUN([AC_F77_LIBRARY_LDFLAGS],
+[AC_REQUIRE([AC_PROG_F77])dnl
+AC_LANG_PUSH(Fortran 77)dnl
+_AC_FC_LIBRARY_LDFLAGS
+AC_LANG_POP(Fortran 77)dnl
+])# AC_F77_LIBRARY_LDFLAGS
+
+
+# AC_FC_LIBRARY_LDFLAGS
+# ---------------------
+AC_DEFUN([AC_FC_LIBRARY_LDFLAGS],
+[AC_REQUIRE([AC_PROG_FC])dnl
+AC_LANG_PUSH(Fortran)dnl
+_AC_FC_LIBRARY_LDFLAGS
+AC_LANG_POP(Fortran)dnl
+])# AC_FC_LIBRARY_LDFLAGS
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+*.mod *_scratch.f Makefile.conf *.lst
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/Makefile	(revision 4775)
@@ -0,0 +1,109 @@
+.NOTPARALLEL:
+SHELL           = /bin/sh
+VPATH=$(SRCDIR)/mct 
+# SOURCE FILES
+
+MODULE		= mct
+
+SRCS_F90	= m_MCTWorld.F90		\
+		  m_AttrVect.F90		\
+		  m_GlobalMap.F90	        \
+		  m_GlobalSegMap.F90		\
+		  m_GlobalSegMapComms.F90	\
+		  m_Accumulator.F90		\
+		  m_SparseMatrix.F90      	\
+		  m_Navigator.F90		\
+		  m_AttrVectComms.F90		\
+		  m_AttrVectReduce.F90		\
+		  m_AccumulatorComms.F90  	\
+		  m_GeneralGrid.F90		\
+		  m_GeneralGridComms.F90	\
+		  m_SpatialIntegral.F90		\
+		  m_SpatialIntegralV.F90	\
+		  m_MatAttrVectMul.F90    	\
+		  m_Merge.F90			\
+		  m_GlobalToLocal.F90		\
+		  m_ExchangeMaps.F90		\
+		  m_ConvertMaps.F90		\
+		  m_SparseMatrixDecomp.F90	\
+		  m_SparseMatrixToMaps.F90	\
+		  m_SparseMatrixComms.F90 	\
+		  m_SparseMatrixPlus.F90	\
+		  m_Router.F90			\
+		  m_Rearranger.F90        	\
+		  m_Transfer.F90                \
+                  mct_mod.F90
+
+
+OBJS_ALL	= $(SRCS_F90:.F90=.o)
+
+# MACHINE AND COMPILER FLAGS
+
+include ../Makefile.conf
+
+# TARGETS
+
+all: 	lib$(MODULE).a
+
+lib$(MODULE).a:	$(OBJS_ALL)
+	$(RM) $@
+	$(AR) $@ $(OBJS_ALL)
+
+# ADDITIONAL FLAGS SPECIFIC FOR MCT COMPILATION
+
+MCTFLAGS = $(INCFLAG)$(MPEUPATH)
+
+# RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .o
+
+.F90.o:
+	$(FC) -c $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MCTFLAGS) $<
+
+
+clean:
+	${RM} *.o *.mod lib$(MODULE).a
+
+install: all
+	$(MKINSTALLDIRS) $(libdir) $(includedir)
+	$(INSTALL) lib$(MODULE).a -m 644 $(libdir)
+	@for modfile in *.mod; do                         \
+	  echo $(INSTALL) $$modfile -m 644 $(includedir); \
+	  $(INSTALL) $$modfile -m 644 $(includedir);      \
+	done
+
+# DEPENDENCIES
+
+$(OBJS_ALL): $(MPEUPATH)/libmpeu.a
+
+m_AttrVect.o: 
+m_Accumulator.o: m_AttrVect.o
+m_GlobalMap.o:
+m_GlobalSegMap.o:
+m_GlobalSegMapComms.o: m_GlobalSegMap.o
+m_Navigator.o:
+m_AttrVectComms.o: m_AttrVect.o m_GlobalMap.o
+m_AttrVectReduce.o: m_AttrVect.o
+m_AccumulatorComms.o: m_AttrVect.o m_GlobalMap.o m_AttrVectComms.o
+m_SparseMatrix.o: m_AttrVect.o m_GlobalMap.o m_AttrVectComms.o
+m_GeneralGrid.o: m_AttrVect.o
+m_GeneralGridComms.o: m_AttrVect.o m_GeneralGrid.o m_AttrVectComms.o m_GlobalMap.o m_GlobalSegMap.o
+m_MatAttrVectMul.o: m_AttrVect.o m_SparseMatrix.o m_GlobalMap.o m_GlobalSegMap.o m_SparseMatrixPlus.o m_Rearranger.o
+m_Merge.o: m_AttrVect.o m_GeneralGrid.o
+m_Router.o: m_GlobalToLocal.o m_MCTWorld.o m_GlobalSegMap.o m_ExchangeMaps.o
+m_Rearranger.o: m_Router.o m_MCTWorld.o m_GlobalSegMap.o m_AttrVect.o
+m_GlobalToLocal.o: m_GlobalSegMap.o
+m_ExchangeMaps.o: m_GlobalMap.o m_GlobalSegMap.o m_MCTWorld.o m_ConvertMaps.o
+m_ConvertMaps.o: m_GlobalMap.o m_GlobalSegMap.o m_MCTWorld.o
+m_SparseMatrixDecomp.o: m_SparseMatrix.o m_GlobalSegMap.o
+m_SparseMatrixToMaps.o: m_SparseMatrix.o m_GlobalSegMap.o
+m_SparseMatrixComms.o:	m_SparseMatrix.o m_SparseMatrixDecomp.o m_GlobalSegMap.o m_AttrVectComms.o
+accumulate.o: m_AttrVect.o m_Accumulator.o
+m_SpatialIntegral.o: m_SpatialIntegralV.o m_GeneralGrid.o m_AttrVect.o m_AttrVectReduce.o
+m_SpatialIntegralV.o: m_AttrVect.o m_AttrVectReduce.o
+m_Transfer.o: m_AttrVect.o m_Router.o m_MCTWorld.o
+m_SparseMatrixPlus.o: m_GlobalSegMap.o m_Rearranger.o m_SparseMatrix.o m_SparseMatrixComms.o m_SparseMatrixToMaps.o m_GlobalToLocal.o
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/README	(revision 4775)
@@ -0,0 +1,39 @@
+######################################################################
+
+ -- Mathematics + Computer Science Div. / Argonne National Laboratory
+
+    Model Coupling Toolkit (MCT)
+
+    Jay Larson
+    Robert Jacob
+    Everest Ong
+
+    For more information, see http://www.mcs.anl.gov/mct
+
+######################################################################
+!-----------------------------------------------------------------------
+! CVS README,v 1.2 2004-04-23 21:57:32 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+
+This directory contains the basic MCT source code.
+
+MCT distribution contents:
+MCT/
+MCT/COPYRIGHT
+MCT/doc/
+MCT/examples/
+MCT/mct/   <- You are here
+MCT/mpeu/ 
+MCT/protex/
+
+A complete distribution of MCT can be obtained from http://www.mcs.anl.gov/mct.
+
+---------------------------------------------------
+Build instructions:
+In the top level, type "make" to build mct and mpeu.
+
+If ./configure was already run and mpeu was already built,
+you can type "make" in this directory.
+
+---------------------------------------------------
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Accumulator.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Accumulator.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Accumulator.F90	(revision 4775)
@@ -0,0 +1,2471 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Accumulator.F90,v 1.37 2008-05-15 13:20:10 larson Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Accumulator - Time Averaging/Accumlation Buffer
+!
+! !DESCRIPTION:
+!
+! An {\em accumulator} is a data class used for computing running sums 
+! and/or time averages of {\tt AttrVect} class data.
+! The period of time over which data are accumulated/averaged is the 
+! {\em accumulation cycle}, which is defined by the total number 
+! of accumulation steps (the component {\tt Accumulator\%num\_steps}).  When
+! the accumulation routine {\tt accumulate\_} is invoked, the number
+! of accumulation cycle steps (the component 
+! {\tt Accumulator\%steps\_done})is incremented, and compared with 
+! the number of steps in the accumulation cycle to determine if the 
+! accumulation cycle has been completed.  The accumulation buffers 
+! of the {\tt Accumulator} are stored in an {\tt AttrVect} (namely 
+! the component {\tt Accumulator\%data}), which allows the user to 
+! define the number of variables and their names at run-time.
+! Finally, one can define for each field 
+! being accumulated the specific accumulation {\em action}.  Currently,
+! there are two options:  Time Averaging and Time Summation.  The 
+! user chooses the specific action by setting an integer action 
+! flag for each attribute being accumulated.  The supported options
+! are defined by the public data member constants {\tt MCT\_SUM} and
+! {\tt MCT\_AVG}.
+! \\
+! This module also supports a simple usage of accumulator where all
+! the actions are SUM ({\tt inits\_} and {\tt initavs\_}) and the user
+! must call {\tt average\_} to calculate the average from the current
+! value of {\tt Accumulator\%steps\_done}.  {\tt Accumulator\%num\_steps}
+! is ignored in this case.
+!
+! !INTERFACE:
+
+ module m_Accumulator
+!
+! !USES:
+!
+      use m_List, only : List
+      use m_AttrVect, only : AttrVect
+      use m_realkinds,only : SP,DP,FP
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: Accumulator ! The class data structure
+
+    Type Accumulator
+#ifdef SEQUENCE
+      sequence
+#endif
+      integer :: num_steps      ! total number of accumulation steps
+      integer :: steps_done     ! number of accumulation steps performed
+      integer, pointer, dimension(:) :: iAction ! index of integer actions
+      integer, pointer, dimension(:) :: rAction ! index of real actions
+      type(AttrVect) :: data    ! accumulated sum field storage
+    End Type Accumulator
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+      public :: init            ! creation method
+      public :: initp           ! partial creation method (MCT USE ONLY)
+      public :: clean		! destruction method
+      public :: initialized     ! check if initialized
+      public :: lsize		! local length of the data arrays
+      public :: NumSteps        ! number of steps in a cycle
+      public :: StepsDone       ! number of steps completed in the 
+                                ! current cycle
+      public :: nIAttr		! number of integer fields
+      public :: nRAttr		! number of real fields
+      public :: indexIA		! index the integer fields
+      public :: indexRA		! index the real fields
+      public :: getIList	! Return tag from INTEGER 
+                                ! attribute list
+      public :: getRList	! Return tag from REAL attribute
+                                ! list
+      public :: exportIAttr  ! Return INTEGER attribute as a vector
+      public :: exportRAttr  ! Return REAL attribute as a vector
+      public :: importIAttr  ! Insert INTEGER vector as attribute
+      public :: importRAttr  ! Insert REAL vector as attribute
+      public :: zero         ! Clear an accumulator
+      public :: SharedAttrIndexList ! Returns the number of shared
+				    ! attributes, and lists of the
+				    ! respective locations of these
+				    ! shared attributes
+      public :: accumulate   ! Add AttrVect data into an Accumulator
+      public :: average      ! Calculate an average in an Accumulator
+
+! Definition of interfaces for the methods for the Accumulator:
+
+    interface init   ; module procedure	&
+       init_,	&
+       inits_,	&
+       initv_,  &
+       initavs_
+    end interface
+    interface initp  ; module procedure	initp_ ; end interface
+    interface clean  ; module procedure clean_  ; end interface
+    interface initialized; module procedure initialized_ ; end interface
+    interface lsize  ; module procedure lsize_  ; end interface
+    interface NumSteps  ; module procedure NumSteps_  ; end interface
+    interface StepsDone  ; module procedure StepsDone_  ; end interface
+    interface nIAttr ; module procedure nIAttr_ ; end interface
+    interface nRAttr ; module procedure nRAttr_ ; end interface
+    interface indexIA; module procedure indexIA_; end interface
+    interface indexRA; module procedure indexRA_; end interface
+    interface getIList; module procedure getIList_; end interface
+    interface getRList; module procedure getRList_; end interface
+    interface exportIAttr ; module procedure exportIAttr_ ; end interface
+    interface exportRAttr ; module procedure &
+         exportRAttrSP_, &
+         exportRAttrDP_
+    end interface
+    interface importIAttr ; module procedure importIAttr_ ; end interface
+    interface importRAttr ; module procedure &
+         importRAttrSP_, &
+         importRAttrDP_
+    end interface
+    interface zero ; module procedure zero_ ; end interface
+    interface SharedAttrIndexList ; module procedure   &
+       aCaCSharedAttrIndexList_,  &   
+       aVaCSharedAttrIndexList_
+    end interface
+    interface accumulate ; module procedure accumulate_ ; end interface
+    interface average ; module procedure average_ ; end interface
+
+! !PUBLIC DATA MEMBERS:
+!
+      public :: MCT_SUM
+      public :: MCT_AVG
+
+    integer, parameter :: MCT_SUM = 1
+    integer, parameter :: MCT_AVG = 2
+
+! !REVISION HISTORY:
+!  7Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!  7Feb01 - Jay Larson <larson@mcs.anl.gov> - Public interfaces
+!           to getIList() and getRList().
+!  9Aug01 - E.T. Ong <eong@mcs.anl.gov> - added initialized and
+!           initp_ routines. Added 'action' in Accumulator type.
+!  6May02 - Jay Larson <larson@mcs.anl.gov> - added import/export
+!            routines.
+!  26Aug02 - E.T. Ong <eong@mcs.anl.gov> - thourough code revision; 
+!            no added routines
+!  10Jan08 - R. Jacob <jacob@mcs.anl.gov> - add simple accumulator
+!            use support and check documentation.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Accumulator'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Initialize an Accumulator and its Registers
+!
+! !DESCRIPTION:
+! This routine allocates space for the output {\tt Accumulator} argument 
+! {\tt aC}, and at a minimum sets the number of time steps in an 
+! accumulation cycle (defined by the input {\tt INTEGER} argument 
+! {\tt num\_steps}), and the {\em length} of the {\tt Accumulator} 
+! register buffer (defined by the input {\tt INTEGER} argument {\tt 
+! lsize}).  If one wishes to accumulate integer fields, the list of
+! these fields is defined by the input {\tt CHARACTER} argument 
+! {\tt iList}, which is specified as a colon-delimited set of 
+! substrings (further information regarding this is available in the 
+! routine {\tt init\_()} of the module {\tt m\_AttrVect}).  If no 
+! value of {\tt iList} is supplied, no integer attribute accumulation 
+! buffers will be allocated.  The accumulation action on each of the
+! integer attributes can be defined by supplying the input {\tt INTEGER}
+! array argument {\tt iAction(:)} (whose length must correspond to the
+! number of items in {\tt iList}).  The values of the elements of 
+! {\tt iAction(:)} must be one of the values among the public data 
+! members defined in the declaration section of this module.  If the
+! integer attributes are to be accumulated (i.e. one supplies {\tt iList}),
+! but {\tt iAction(:)} is not specified, the default action for all 
+! integer accumulation operations will be summation.  The input arguments
+! {\tt rList} and {\tt rAction(:)} define the names of the real variables 
+! to be accumulated and the accumulation action for each.  The arguments
+! {\tt rList} and {\tt rAction(:)} are related to each other the same 
+! way as {\tt iList} and {\tt iAction(:)}.  Finally, the user can 
+! manually set the number of completed steps in an accumulation cycle
+! (e.g. for restart purposes) by supplying a value for the optional 
+! input {\tt INTEGER} argument {\tt steps\_done}.
+!
+! !INTERFACE:
+
+ subroutine init_(aC, iList, iAction, rList, rAction, lsize, &
+                  num_steps,steps_done)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      use m_List, only: List
+      use m_List, only: List_nullify => nullify
+      use m_List, only: List_init => init
+      use m_List, only: List_nitem => nitem
+      use m_List, only: List_clean => clean
+
+      use m_stdio
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*),      optional, intent(in)  :: iList
+      integer, dimension(:), optional, intent(in)  :: iAction
+      character(len=*),      optional, intent(in)  :: rList
+      integer, dimension(:), optional, intent(in)  :: rAction
+      integer,                         intent(in)  :: lsize
+      integer,                         intent(in)  :: num_steps
+      integer,               optional, intent(in)  :: steps_done
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),               intent(out) :: aC
+
+! !REVISION HISTORY:
+! 11Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 27JUL01 - E.T. Ong <eong@mcs.anl.gov> - added iAction, rAction,
+!           niAction, and nrAction to accumulator type. Also defined
+!           MCT_SUM and MCT_AVG for accumulator module.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::init_'
+  integer :: my_steps_done, nIAttr, nRAttr, ierr
+  integer, dimension(:), pointer :: my_iAction, my_rAction
+  logical :: status
+  type(List) :: temp_iList, temp_rList
+
+  nullify(my_iAction)
+  nullify(my_rAction)
+
+  call List_nullify(temp_iList)
+  call List_nullify(temp_rList)
+
+        ! Argument consistency checks:  
+
+        ! 1) Terminate with error message if optional argument iAction (rAction) 
+        ! is supplied but optional argument iList (rList) is not.
+
+  if(present(iAction) .and. (.not. present(iList))) then
+     write(stderr,'(2a)') myname_,'::FATAL--Argument iAction supplied but action iList absent!'
+     call die(myname_)
+  endif
+
+  if(present(rAction) .and. (.not. present(rList))) then
+     write(stderr,'(2a)') myname_,'::FATAL--Argument rAction supplied but action rList absent!'
+     call die(myname_)
+  endif
+
+        ! 2) For iList and rList, generate temporary List data structures to facilitate
+        ! attribute counting.
+
+  if(present(iList)) then ! create temp_iList
+     call List_init(temp_iList, iList)
+     nIAttr = List_nitem(temp_iList)
+  endif
+
+  if(present(rList)) then ! create temp_iList
+     call List_init(temp_rList, rList)
+     nRAttr = List_nitem(temp_rList)
+  endif
+
+        ! 3) Terminate with error message if optional arguments iAction (rAction) 
+        ! and iList (rList) are supplied but the size of iAction (rAction) does not 
+        ! match the number of items in iList (rList).
+
+  if(present(iAction) .and.  present(iList)) then
+     if(size(iAction) /= nIAttr) then
+        write(stderr,'(2a,2(a,i8))') myname_, &
+             '::FATAL--Size mismatch between iAction and iList!  ', &
+             'size(iAction)=',size(iAction),', ','No. items in iList=',nIAttr
+        call die(myname_)
+     endif
+  endif
+
+  if(present(rAction) .and.  present(rList)) then
+     if(size(rAction) /= nRAttr) then
+        write(stderr,'(2a,2(a,i8))') myname_, &
+             '::FATAL--Size mismatch between rAction and rList!  ', &
+             'size(rAction)=',size(rAction),', ','No items in rList=',nRAttr
+        call die(myname_)
+     endif
+  endif
+
+        ! Initialize the Accumulator components.
+
+        ! steps_done:
+
+  if(present(steps_done)) then
+     my_steps_done = steps_done
+  else
+     my_steps_done = 0
+  endif
+
+        ! my_iAction (if iList is present)
+
+  if(present(iList)) then ! set up my_iAction
+
+     allocate(my_iAction(nIAttr), stat=ierr)
+     if(ierr /= 0) then
+        write(stderr,'(2a,i8)') myname_, &
+           '::FATAL: allocate(my_iAction) failed with ierr=',ierr
+        call die(myname_)
+     endif
+     
+     if(present(iAction)) then ! use its values
+        my_iAction = iAction
+     else ! go with default summation by assigning value MCT_SUM
+        my_iAction = MCT_SUM
+     endif
+
+  endif
+
+        ! my_rAction (if rList is present)
+
+  if(present(rList)) then ! set up my_rAction
+
+     allocate(my_rAction(nRAttr), stat=ierr)
+     if(ierr /= 0) then
+        write(stderr,'(2a,i8)') myname_, &
+           '::FATAL: allocate(my_rAction) failed with ierr=',ierr
+        call die(myname_)
+     endif
+     
+     if(present(rAction)) then ! use its values
+        my_rAction = rAction
+     else ! go with default summation by assigning value MCT_SUM
+        my_rAction = MCT_SUM
+     endif
+
+  endif
+  
+        ! Build the Accumulator aC minus its data component:
+
+  if(present(iList) .and. present(rList)) then ! Both REAL and INTEGER registers
+
+     call initp_(aC,my_iAction,my_rAction,num_steps,my_steps_done)
+
+     deallocate(my_iAction, my_rAction, stat=ierr)
+     if(ierr /= 0) then
+        write(stderr,'(2a,i8)') myname_, &
+           '::FATAL: deallocate(my_iAction, my_rAction) failed with ierr=',ierr
+        call die(myname_)
+     endif
+
+  else ! Either only REAL or only INTEGER registers in aC
+
+     if(present(iList)) then ! Only  INTEGER REGISTERS
+
+	call initp_(aC=aC, iAction=my_iAction, num_steps=num_steps, &
+	            steps_done=my_steps_done)
+
+        deallocate(my_iAction, stat=ierr)
+        if(ierr /= 0) then
+           write(stderr,'(2a,i8)') myname_, &
+                '::FATAL: deallocate(my_iAction) failed with ierr=',ierr
+           call die(myname_)
+        endif
+
+     endif
+
+     if(present(rList)) then ! Only  REAL REGISTERS
+
+	call initp_(aC=aC, rAction=my_rAction, num_steps=num_steps, &
+	            steps_done=my_steps_done)
+
+        deallocate(my_rAction, stat=ierr)
+        if(ierr /= 0) then
+           write(stderr,'(2a,i8)') myname_, &
+                '::FATAL: deallocate(my_rAction) failed with ierr=',ierr
+           call die(myname_)
+        endif
+
+     endif
+
+  endif
+
+        ! Initialize the AttrVect data component for aC:
+
+  if(present(iList) .and. present(rList)) then
+     call AttrVect_init(aC%data,iList,rList,lsize)
+  else
+     if(present(iList)) then
+	call AttrVect_init(aV=aC%data,iList=iList,lsize=lsize)
+     endif
+     if(present(rList)) then
+	call AttrVect_init(aV=aC%data,rList=rList,lsize=lsize)
+     endif
+  endif
+
+  call AttrVect_zero(aC%data)
+
+        ! Clean up
+
+  if(present(iList)) call List_clean(temp_iList)
+  if(present(rList)) call List_clean(temp_rList)
+
+        ! Check that aC has been properly initialized
+
+  status = initialized_(aC=aC,die_flag=.true.,source_name=myname_)
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: inits_ - Initialize a simple Accumulator and its Registers
+!
+! !DESCRIPTION:
+! This routine allocates space for the output simple {\tt Accumulator} argument 
+! {\tt aC}, and sets the {\em length} of the {\tt Accumulator} 
+! register buffer (defined by the input {\tt INTEGER} argument {\tt 
+! lsize}).  If one wishes to accumulate integer fields, the list of
+! these fields is defined by the input {\tt CHARACTER} argument 
+! {\tt iList}, which is specified as a colon-delimited set of 
+! substrings (further information regarding this is available in the 
+! routine {\tt init\_()} of the module {\tt m\_AttrVect}).  If no 
+! value of {\tt iList} is supplied, no integer attribute accumulation 
+! buffers will be allocated.   The input argument {\tt rList} define
+! the names of the real variables  to be accumulated. Finally, the user can 
+! manually set the number of completed steps in an accumulation cycle
+! (e.g. for restart purposes) by supplying a value for the optional 
+! input {\tt INTEGER} argument {\tt steps\_done}.
+! Its default value is zero.
+!
+! In a simple accumulator, the action is always SUM.
+!
+!
+! !INTERFACE:
+
+ subroutine inits_(aC, iList, rList, lsize,steps_done)
+!
+! !USES:
+!
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+      use m_List, only : List_nitem => nitem
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*),      optional, intent(in)  :: iList
+      character(len=*),      optional, intent(in)  :: rList
+      integer,                         intent(in)  :: lsize
+      integer,               optional, intent(in)  :: steps_done
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),               intent(out) :: aC
+
+! !REVISION HISTORY:
+! 10Jan08 - R. Jacob <jacob@mcs.anlgov> - initial version based on init_
+!
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::inits_'
+  type(List) :: tmplist
+  integer :: my_steps_done,ier,i,actsize
+  logical :: status
+
+        ! Initialize the Accumulator components.
+
+  if(present(steps_done)) then
+     my_steps_done = steps_done
+  else
+     my_steps_done = 0
+  endif
+
+  aC%num_steps = -1   ! special value for simple aC
+  aC%steps_done = my_steps_done
+
+  nullify(aC%iAction,aC%rAction)
+
+  if(present(iList)) then
+     call List_init(tmplist,iList)
+     actsize=List_nitem(tmplist)
+     allocate(aC%iAction(actsize),stat=ier)
+     if(ier /= 0) call die(myname_,"iAction allocate",ier)
+     do i=1,lsize
+       aC%iAction=MCT_SUM
+     enddo
+     call List_clean(tmplist)
+  endif
+
+  if(present(rList)) then
+     call List_init(tmplist,rList)
+     actsize=List_nitem(tmpList)
+     allocate(aC%rAction(actsize),stat=ier)
+     if(ier /= 0) call die(myname_,"rAction allocate",ier)
+     do i=1,lsize
+       aC%rAction=MCT_SUM
+     enddo
+     call List_clean(tmplist)
+  endif
+
+        ! Initialize the AttrVect component aC:
+
+  if(present(iList) .and. present(rList)) then
+     call AttrVect_init(aC%data,iList,rList,lsize)
+  else
+     if(present(iList)) then
+	call AttrVect_init(aV=aC%data,iList=iList,lsize=lsize)
+     endif
+     if(present(rList)) then
+	call AttrVect_init(aV=aC%data,rList=rList,lsize=lsize)
+     endif
+  endif
+
+  call AttrVect_zero(aC%data)
+
+        ! Check that aC has been properly initialized
+
+  status = initialized_(aC=aC,die_flag=.true.,source_name=myname_)
+
+ end subroutine inits_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initp_ - Initialize an Accumulator but not its Registers
+!
+! !DESCRIPTION: 
+! This routine is an internal service routine for use by the other 
+! initialization routines in this module.  It sets up some---but not
+! all---of the components of the output {\tt Accumulator} argument 
+! {\tt aC}.  This routine can set up the following components of 
+! {\tt aC}:
+! \begin{enumerate}
+! \item {\tt aC\%iAction}, the array of accumlation actions for the
+! integer attributes of {\tt aC} (if the input {\tt INTEGER} array 
+! argument {\tt iAction(:)} is supplied);
+! \item {\tt aC\%rAction}, the array of accumlation actions for the
+! real attributes of {\tt aC} (if the input {\tt INTEGER} array 
+! argument {\tt rAction(:)} is supplied);
+! \item {\tt aC\%num\_steps}, the number of steps in an accumulation
+! cycle (if the input {\tt INTEGER} argument {\tt num\_steps} is 
+! supplied); and
+! \item {\tt aC\%steps\_done}, the number of steps completed so far 
+! in an accumulation cycle (if the input {\tt INTEGER} argument 
+! {\tt steps\_done} is supplied).
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ subroutine initp_(aC, iAction, rAction, num_steps, steps_done)
+
+!
+! !USES:
+!
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer, dimension(:), optional, intent(in)  :: iAction
+      integer, dimension(:), optional, intent(in)  :: rAction
+      integer,                         intent(in)  :: num_steps
+      integer,               optional, intent(in)  :: steps_done
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),               intent(out) :: aC
+
+! !REVISION HISTORY:
+! 11Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 27JUL01 - E.T. Ong <eong@mcs.anl.gov> - added iAction, rAction,
+!           niAction, and nrAction to accumulator type. Also defined
+!           MCT_SUM and MCT_AVG for accumulator module.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initp_'
+  integer :: i,ier
+  integer :: steps_completed
+
+        ! if the argument steps_done is not present, assume
+        ! the accumulator is starting at step zero, that is,
+        ! set steps_completed to zero
+
+  steps_completed = 0
+  if(present(steps_done)) steps_completed = steps_done
+
+        ! Set the stepping info:
+
+  aC%num_steps = num_steps
+  aC%steps_done = steps_completed
+
+
+        ! Assign iAction and niAction components 
+
+  nullify(aC%iAction,aC%rAction)
+
+  if(present(iAction)) then
+
+     if(size(iAction)>0) then
+
+	allocate(aC%iAction(size(iAction)),stat=ier)
+	if(ier /= 0) call die(myname_,"iAction allocate",ier)
+      
+	do i=1,size(iAction)
+	   aC%iAction(i) = iAction(i)
+	enddo
+
+     endif
+
+  endif
+
+  if(present(rAction)) then
+
+     if(size(rAction)>0) then
+     
+	allocate(aC%rAction(size(rAction)),stat=ier)
+	if(ier /= 0) call die(myname_,"iAction allocate",ier)
+
+	do i=1,size(rAction)
+	   aC%rAction(i) = rAction(i)
+	enddo
+	 
+     endif
+
+  endif
+
+ end subroutine initp_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initv_ - Initialize One Accumulator using Another
+!
+! !DESCRIPTION:
+! This routine takes the integer and real attribute information (including
+! accumulation action settings for each attribute) from a previously 
+! initialized {\tt Accumulator} (the input argument {\tt bC}), and uses
+! it to create another {\tt Accumulator} (the output argument {\tt aC}).
+! In the absence of the {\tt INTEGER} input arguments {\tt lsize}, 
+! {\tt num\_steps}, and {\tt steps\_done}, {\tt aC} will inherit from 
+! {\tt bC} its length, the number of steps in its accumulation cycle, and
+! the number of steps completed in its present accumulation cycle, 
+! respectively.
+!
+! !INTERFACE:
+
+ subroutine initv_(aC, bC, lsize, num_steps, steps_done)
+!
+! !USES:
+!
+      use m_List,   only : List
+      use m_List,   only : ListExportToChar => exportToChar
+      use m_List,   only : List_copy        => copy
+      use m_List,   only : List_allocated   => allocated
+      use m_List,   only : List_clean       => clean
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),           intent(in)  :: bC
+      integer,           optional, intent(in)  :: lsize
+      integer,           optional, intent(in)  :: num_steps
+      integer,           optional, intent(in)  :: steps_done
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),           intent(out) :: aC
+
+! !REVISION HISTORY:
+! 11Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 17May01 - R. Jacob <jacob@mcs.anl.gov> - change string_get to
+!           list_get
+! 27JUL01 - E.T. Ong <eong@mcs.anl.gov> - added iaction,raction 
+!           compatibility
+!  2Aug02 - J. Larson <larson@mcs.anl.gov> made argument num_steps
+!           optional 
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initv_'
+
+  type(List) :: temp_iList, temp_rList
+  integer :: myNumSteps, myStepsDone 
+  integer :: aC_lsize
+  integer :: niActions, nrActions
+  integer, dimension(:), allocatable :: iActionArray, rActionArray
+  integer :: i,ier
+  logical :: status
+
+        ! Check that bC has been initialized
+
+  status = initialized(aC=bC,die_flag=.true.,source_name=myname_)
+
+        ! If the argument steps_done is present, set myStepsDone
+        ! to this value; otherwise, set it to zero
+
+  if(present(num_steps)) then ! set it manually
+     myNumSteps = num_steps
+  else ! inherit it from bC
+     myNumSteps = bC%num_steps
+  endif
+
+        ! If the argument steps_done is present, set myStepsDone
+        ! to this value; otherwise, set it to zero
+
+  if(present(steps_done)) then ! set it manually
+     myStepsDone= steps_done 
+  else ! inherit it from bC
+     myStepsDone = bC%steps_done
+  endif
+
+        ! If the argument lsize is present, 
+        ! set aC_lsize to this value; otherwise, set it to the lsize of bC
+ 
+  if(present(lsize)) then  ! set it manually
+     aC_lsize = lsize     
+  else ! inherit it from bC
+     aC_lsize = lsize_(bC)
+  endif
+
+	! Convert the two Lists to two Strings
+
+  niActions = 0
+  nrActions = 0
+
+  if(List_allocated(bC%data%iList)) then
+     call List_copy(temp_iList,bC%data%iList)
+     niActions = nIAttr_(bC)
+  endif
+
+  if(List_allocated(bC%data%rList)) then
+     call List_copy(temp_rList,bC%data%rList)
+     nrActions = nRAttr_(bC)
+  endif
+
+        ! Convert the pointers to arrays
+
+  allocate(iActionArray(niActions),rActionArray(nrActions),stat=ier)
+  if(ier /= 0) call die(myname_,"iActionArray/rActionArray allocate",ier)
+
+  if( niActions>0 ) then
+     do i=1,niActions
+	iActionArray(i)=bC%iAction(i)
+     enddo
+  endif
+
+  if( nrActions>0 ) then
+     do i=1,nrActions
+	rActionArray(i)=bC%rAction(i)
+     enddo     
+  endif
+
+        ! Call init with present arguments
+
+  if( (niActions>0) .and. (nrActions>0) ) then 
+
+     call init_(aC, iList=ListExportToChar(temp_iList), &
+                iAction=iActionArray,                   &
+	        rList=ListExportToChar(temp_rList),     &
+		rAction=rActionArray,                   &
+                lsize=aC_lsize,                         &    
+                num_steps=myNumSteps,                   &
+                steps_done=myStepsDone)
+
+  else 
+
+     if( niActions>0 ) then
+
+	call init_(aC, iList=ListExportToChar(temp_iList), &
+	           iAction=iActionArray,                   &
+                   lsize=aC_lsize,                         &
+		   num_steps=myNumSteps,                   &
+                   steps_done=myStepsDone)
+
+     endif
+
+     if( nrActions>0 ) then
+
+	call init_(aC, rList=ListExportToChar(temp_rList), &
+	           rAction=rActionArray,                   &
+		   lsize=aC_lsize,                         &
+		   num_steps=myNumSteps,                   &
+                   steps_done=myStepsDone)
+     endif
+
+  endif
+
+  if(List_allocated(bC%data%iList)) call List_clean(temp_iList)
+  if(List_allocated(bC%data%rList)) call List_clean(temp_rList)
+
+  deallocate(iActionArray,rActionArray,stat=ier)
+  if(ier /= 0) call die(myname_,"iActionArray/rActionArray deallocate",ier)
+
+  ! Check that aC as been properly initialized
+
+  status = initialized(aC=aC,die_flag=.true.,source_name=myname_)
+
+ end subroutine initv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initavs_ - Initialize a simple Accumulator from an AttributeVector
+!
+! !DESCRIPTION:
+! This routine takes the integer and real attribute information (including
+! from a previously initialized {\tt AttributeVector} (the input argument {\tt aV}), and uses
+! it to create a simple (sum only) {\tt Accumulator} (the output argument {\tt aC}).
+! In the absence of the {\tt INTEGER} input argument {\tt lsize}, 
+! {\tt aC} will inherit from {\tt Av} its length.  In the absence of the
+! optional INTEGER argument, {\tt steps\_done} will be set to zero.
+!
+! !INTERFACE:
+
+ subroutine initavs_(aC, aV, acsize, steps_done)
+!
+! !USES:
+!
+      use m_AttrVect, only: AttrVect_lsize => lsize
+      use m_AttrVect, only: AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only: AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only: AttrVect_exIL2c => exportIListToChar
+      use m_AttrVect, only: AttrVect_exRL2c => exportRListToChar
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),           intent(in)     :: aV
+      integer,           optional, intent(in)  :: acsize
+      integer,           optional, intent(in)  :: steps_done
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),           intent(out) :: aC
+
+! !REVISION HISTORY:
+! 10Jan08 - R. Jacob <jacob@mcs.anl.gov> - initial version based on initv_
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initavs_'
+
+  integer :: myNumSteps, myStepsDone 
+  integer :: aC_lsize
+  integer :: i,ier
+  integer :: nIatt,nRatt
+  logical :: status
+
+
+        ! If the argument steps_done is present, set myStepsDone
+        ! to this value; otherwise, set it to zero
+
+  if(present(steps_done)) then ! set it manually
+     myStepsDone= steps_done 
+  else ! set it to zero
+     myStepsDone = 0
+  endif
+
+        ! If the argument acsize is present, 
+        ! set aC_lsize to this value; otherwise, set it to the lsize of bC
+ 
+  if(present(acsize)) then  ! set it manually
+     aC_lsize = acsize     
+  else ! inherit it from bC
+     aC_lsize = AttrVect_lsize(aV)
+  endif
+  nIatt=AttrVect_nIAttr(aV)
+  nRatt=AttrVect_nRAttr(aV)
+
+  if((nIAtt>0) .and. (nRatt>0)) then
+     call inits_(aC,AttrVect_exIL2c(aV),AttrVect_exRL2c(aV), &
+                  aC_lsize,myStepsDone)
+  else
+     if(nIatt>0) then
+        call inits_(aC,iList=AttrVect_exIL2c(aV),lsize=aC_lsize, &
+                    steps_done=myStepsDone)
+     endif
+     if(nRatt>0) then
+        call inits_(aC,rList=AttrVect_exRL2c(aV),lsize=aC_lsize, &
+                    steps_done=myStepsDone)
+     endif
+  endif
+
+
+  ! Check that aC as been properly initialized
+
+  status = initialized(aC=aC,die_flag=.true.,source_name=myname_)
+
+ end subroutine initavs_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy an Accumulator
+!
+! !DESCRIPTION:
+! This routine deallocates all allocated memory structures associated 
+! with the input/output {\tt Accumulator} argument {\tt aC}.  The 
+! success (failure) of this operation is signified by the zero (non-zero)
+! value of the optional {\tt INTEGER} output argument {\tt stat}.  If 
+! {\tt clean\_()} is invoked with {\tt stat} present, it is the user's
+! obligation to check this return code and act accordingly.  If {\tt stat}
+! is not supplied and any of the deallocation operations fail, this
+! routine will terminate execution with an error statement.
+!
+! !INTERFACE:
+
+ subroutine clean_(aC, stat)
+!
+! !USES:
+!
+      use m_mall
+      use m_stdio
+      use m_die
+      use m_AttrVect, only : AttrVect_clean => clean
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(inout) :: aC
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 11Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 27JUL01 - E.T. Ong <eong@mcs.anl.gov> - deallocate pointers iAction
+!           and rAction.
+!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> removed the die to prevent
+!           crashes and added stat argument.       
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  if(present(stat)) then
+     stat=0
+     call AttrVect_clean(aC%data,stat)
+  else
+     call AttrVect_clean(aC%data)
+  endif
+
+  if( associated(aC%iAction) )  then
+
+      deallocate(aC%iAction,stat=ier)
+
+      if(ier /= 0) then
+	 if(present(stat)) then
+	    stat=ier
+	 else
+	    call warn(myname_,'deallocate(aC%iAction)',ier)
+	 endif
+      endif
+
+   endif
+
+  if( associated(aC%rAction) ) then
+
+     deallocate(aC%rAction,stat=ier)
+
+      if(ier /= 0) then
+	 if(present(stat)) then
+	    stat=ier
+	 else
+	    call warn(myname_,'deallocate(aC%rAction)',ier)
+	 endif
+      endif
+
+  endif
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initialized_ - Check if an Accumulator is Initialized
+!
+! !DESCRIPTION: 
+! This logical function returns a value of {\tt .TRUE.} if the input 
+! {\tt Accumulator} argument {\tt aC}  is initialized correctly.  The
+! term "correctly initialized" means there is internal consistency 
+! between the number of integer and real attributes in {\tt aC}, and
+! their respective data structures for accumulation registers, and 
+! accumulation action flags.  The optional {\tt LOGICAL} input argument
+! {\tt die\_flag}  if present, can result in messages written to 
+! {\tt stderr}:
+! \begin {itemize}  
+! \item if {\tt die\_flag} is true and {\tt aC} is correctly initialized, 
+! and
+! \item if {\tt die\_flag} is false and {\tt aC} is incorrectly 
+! initialized.
+! \end{itemize}
+! Otherwise, inconsistencies in how {\tt aC} is set up will result in
+! termination with an error message.
+! The optional {\tt CHARACTER} input argument {\tt source\_name} allows
+! the user to, in the event of error, generate traceback information 
+! (e.g., the name of the routine that invoked this one).
+!
+! !INTERFACE:
+
+ logical function initialized_(aC, die_flag, source_name)
+!
+! !USES:
+!
+
+   use m_stdio
+   use m_die
+   use m_List, only : List
+   use m_List, only : List_allocated => allocated
+
+   use m_AttrVect, only : AttrVect
+   use m_AttrVect, only : Attr_nIAttr => nIAttr
+   use m_AttrVect, only : Attr_nRAttr => nRAttr
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(Accumulator),          intent(in) :: aC
+   logical,          optional, intent(in) :: die_flag
+   character(len=*), optional, intent(in) :: source_name
+
+! !REVISION HISTORY:
+!  7AUG01 - E.T. Ong <eong@mcs.anl.gov> - initital prototype
+!
+!EOP ___________________________________________________________________
+
+   character(len=*),parameter :: myname_=myname//'::initialized_'
+   integer :: i
+   logical :: kill
+   logical :: aC_associated
+
+   if(present(die_flag)) then
+      kill = .true.
+   else
+      kill = .false. 
+   endif
+
+          ! Initial value
+   initialized_ = .true. 
+   aC_associated = .true. 
+
+          ! Check the association status of pointers in aC
+
+   if( associated(aC%iAction) .or. associated(aC%rAction) ) then
+      aC_associated = .true.
+   else
+      initialized_ = .false.
+      aC_associated = .false.
+      if(kill) then
+	 if(present(source_name)) write(stderr,*) source_name, myname_, &
+	      ":: ERROR, Neither aC%iAction nor aC%rAction are associated"
+	 call die(myname_,"Neither aC%iAction nor aC%rAction are associated") 
+      endif
+   endif
+
+   if( List_allocated(aC%data%iList) .or. List_allocated(aC%data%rList) ) then
+      aC_associated = .true.
+   else
+      initialized_ = .false.
+      aC_associated = .false.
+      if(kill) then
+	 if(present(source_name)) write(stderr,*) source_name, myname_, &
+	      ":: ERROR, Neither aC%data%iList nor aC%data%rList are allocated"
+	 call die(myname_,"Neither aC%data%iList nor aC%data%rList are allocated")
+      endif
+   endif
+
+           ! Make sure iAction and rAction sizes are greater than zero
+
+   if(associated(aC%iAction)) then
+      if(size(aC%iAction)<=0) then
+	 initialized_ = .false.
+	 aC_associated = .false.
+	 if(kill) then
+	    if(present(source_name)) write(stderr,*) source_name, myname_, &
+		 ":: ERROR, size(aC%iAction<=0), size = ", size(aC%iAction)
+	    call die(myname_,"size(aC%iAction<=0), size = ", size(aC%iAction))
+	 endif
+      endif
+   endif
+
+   if(associated(aC%rAction)) then
+      if(size(aC%rAction)<=0) then
+	 initialized_ = .false.
+	 aC_associated = .false.
+	 if(kill) then
+	    if(present(source_name)) write(stderr,*) source_name, myname_, &
+		 ":: ERROR, size(aC%rAction<=0), size = ", size(aC%rAction)
+	    call die(myname_,"size(aC%rAction<=0), size = ", size(aC%rAction))
+	 endif
+      endif
+   endif
+
+          ! More sanity checking...
+
+   if( aC_associated ) then
+
+      if( (Attr_nIAttr(aC%data) == 0) .and. (Attr_nRAttr(aC%data) == 0) ) then
+	 initialized_ = .false.
+	 if(kill) then
+	    if(present(source_name)) write(stderr,*) source_name, myname_, &
+		 ":: ERROR, No attributes found in aC%data"
+	    call die(myname_,"No attributes found in aC%data")
+	 endif
+      endif
+
+      if(Attr_nIAttr(aC%data) > 0) then
+
+	 if( size(aC%iAction) /=  Attr_nIAttr(aC%data) ) then
+	    initialized_ = .false.
+	    if(kill) then
+	       if(present(source_name)) write(stderr,*) source_name, myname_, &
+		    ":: ERROR, size(aC%iAction) /= nIAttr(aC%data)"
+	       call die(myname_,"size(aC%iAction) /= nIAttr(aC%data)")
+	    endif
+	 endif
+
+	 do i=1,Attr_nIAttr(aC%data)
+	    if( (aC%iAction(i) /= MCT_SUM) .and. &
+                (aC%iAction(i) /= MCT_AVG) ) then
+	       initialized_ = .false.
+	       if(kill) then
+		  if(present(source_name)) write(stderr,*) source_name, &
+		       myname_, ":: ERROR, Invalid value found in aC%iAction"
+		  call die(myname_,"Invalid value found in aC%iAction", &
+		       aC%iAction(i))
+	       endif
+	    endif
+	 enddo
+
+      endif ! if(Attr_nIAttr(aC%data) > 0)
+
+      if(Attr_nRAttr(aC%data) > 0) then
+
+	 if( size(aC%rAction) /=  Attr_nRAttr(aC%data) ) then
+	    initialized_ = .false.
+	    if(kill) then
+	      if(present(source_name)) write(stderr,*) source_name, &
+		   myname_, ":: ERROR, size(aC%rAction) /= nRAttr(aC%data)"
+	      call die(myname_,"size(aC%rAction) /= nRAttr(aC%data)")
+	    endif
+	 endif
+
+	 do i=1,Attr_nRAttr(aC%data)
+	    if( (aC%rAction(i) /= MCT_SUM) .and. &
+                (aC%rAction(i) /= MCT_AVG) ) then
+	       initialized_ = .false.
+	       if(kill) then
+		  if(present(source_name)) write(stderr,*) source_name, &
+		       myname_, ":: ERROR, Invalid value found in aC%rAction", &
+		       aC%rAction(i)
+		  call die(myname_,"Invalid value found in aC%rAction", &
+		       aC%iAction(i)) 
+	       endif
+	    endif
+	 enddo
+
+      endif ! if(Attr_nRAttr(aC%data) > 0)
+
+   endif  ! if (aC_associated)
+
+ end function initialized_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize_ - Length of an Accumulator
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the number of data points 
+! for which the input {\tt Accumulator} argument {\tt aC} is performing
+! accumulation.  This value corresponds to the length of the {\tt AttrVect}
+! component {\tt aC\%data} that stores the accumulation registers.
+!
+! !INTERFACE:
+
+ integer function lsize_(aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator), intent(in) :: aC
+
+! !REVISION HISTORY:
+! 12Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::lsize_'
+
+
+	! The function AttrVect_lsize is called to return
+        ! its local size data
+
+  lsize_=AttrVect_lsize(aC%data)
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: NumSteps_ - Number of Accumulation Cycle Time Steps
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the number of time steps in an 
+! accumulation cycle for the input {\tt Accumulator} argument {\tt aC}.
+!
+! !INTERFACE:
+
+ integer function NumSteps_(aC)
+!
+! !USES:
+!
+      use m_die,   only : die
+      use m_stdio, only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator), intent(in) :: aC
+
+! !REVISION HISTORY:
+!  7Aug02 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::NumSteps_'
+
+  integer :: myNumSteps
+
+
+	! Retrieve the number of cycle steps from aC:
+
+  myNumSteps = aC%num_steps
+
+  if(myNumSteps <= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: FATAL--illegal number of steps in an accumulation cycle = ',&
+	  myNumSteps
+     call die(myname_)
+  endif
+
+  NumSteps_ = myNumSteps
+
+ end function NumSteps_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: StepsDone_ - Number of Completed Steps in the Current Cycle
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the of time steps that have 
+! been completed in the current accumulation cycle for the input 
+! {\tt Accumulator} argument {\tt aC}.
+!
+! !INTERFACE:
+
+ integer function StepsDone_(aC)
+!
+! !USES:
+!
+      use m_die,   only : die
+      use m_stdio, only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator), intent(in) :: aC
+
+! !REVISION HISTORY:
+!  7Aug02 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::StepsDone_'
+
+  integer :: myStepsDone
+
+	! Retrieve the number of completed steps from aC:
+
+  myStepsDone = aC%steps_done
+
+  if(myStepsDone < 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: FATAL--illegal number of completed steps = ',&
+	  myStepsDone
+     call die(myname_)
+  endif
+
+  StepsDone_ = myStepsDone
+
+ end function StepsDone_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nIAttr_ - Return the Number of INTEGER Attributes
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the number of integer 
+! attributes that are stored in the input {\tt Accumulator} argument 
+! {\tt aC}.  This value is equal to the number of integer attributes 
+! in the {\tt AttrVect} component {\tt aC\%data} that stores the 
+! accumulation registers.
+!
+! !INTERFACE:
+
+ integer function nIAttr_(aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),intent(in) :: aC
+
+! !REVISION HISTORY:
+! 12Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nIAttr_'
+
+	! The function AttrVect_nIAttr is called to return the
+        ! number of integer fields
+
+  nIAttr_=AttrVect_nIAttr(aC%data)
+
+ end function nIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nRAttr_ - number of REAL fields stored in the Accumulator.
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the number of real
+! attributes that are stored in the input {\tt Accumulator} argument 
+! {\tt aC}.  This value is equal to the number of real attributes 
+! in the {\tt AttrVect} component {\tt aC\%data} that stores the 
+! accumulation registers.
+!
+! !INTERFACE:
+
+ integer function nRAttr_(aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+ 
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),intent(in) :: aC
+
+! !REVISION HISTORY:
+! 12Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nRAttr_'
+
+	! The function AttrVect_nRAttr is called to return the
+        ! number of real fields
+
+  nRAttr_=AttrVect_nRAttr(aC%data)
+
+ end function nRAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getIList_ - Retrieve a Numbered INTEGER Attribute Name
+!
+! !DESCRIPTION:
+! This routine returns as a {\tt String} (see the mpeu module 
+! {\tt m\_String} for information) the name of the {\tt ith} item in 
+! the integer registers of the {\tt Accumulator} argument {\tt aC}.
+!
+! !INTERFACE:
+
+ subroutine getIList_(item, ith, aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_getIList => getIList
+      use m_String,   only : String
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,           intent(in)  :: ith
+      type(Accumulator), intent(in)  :: aC
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),      intent(out) :: item
+
+! !REVISION HISTORY:
+! 12Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getIList_'
+
+  call AttrVect_getIList(item,ith,aC%data)
+
+ end subroutine getIList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getRList_ - Retrieve a Numbered REAL Attribute Name
+!
+! !DESCRIPTION:
+! This routine returns as a {\tt String} (see the mpeu module 
+! {\tt m\_String} for information) the name of the {\tt ith} item in 
+! the real registers of the {\tt Accumulator} argument {\tt aC}.
+!
+! !INTERFACE:
+
+ subroutine getRList_(item, ith, aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_getRList => getRList
+      use m_String,   only : String
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,          intent(in)  :: ith
+      type(Accumulator),intent(in)  :: aC
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),     intent(out) :: item
+
+! !REVISION HISTORY:
+! 12Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getRList_'
+
+  call AttrVect_getRList(item,ith,aC%data)
+
+ end subroutine getRList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexIA_ - Index an INTEGER Attribute
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the index in the integer 
+! accumulation register buffer of the {\tt Accumulator} argument {\tt aC} 
+! the attribute named by the {\tt CHARACTER} argument {\tt item}.  That
+! is, all the accumulator running tallies for the attribute named 
+! {\tt item} reside in 
+!\begin{verbatim}
+! aC%data%iAttr(indexIA_(aC,item),:).
+!\end{verbatim}
+! The user may request traceback information (e.g., the name of the 
+! routine from which this one is called) by providing values for either 
+! of the optional {\tt CHARACTER} arguments {\tt perrWith} or {\tt dieWith}
+! In the event {\tt indexIA\_()} can not find {\tt item} in {\tt aC}, 
+! the routine behaves as follows:
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexIA\_()} returns a value of zero;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}.
+! \end{enumerate}
+! !INTERFACE:
+
+ integer function indexIA_(aC, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+      use m_die,  only : die
+      use m_stdio,only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),          intent(in) :: aC
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 14Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexIA_'
+
+  indexIA_=AttrVect_indexIA(aC%data,item)
+
+	if(indexIA_==0) then
+	  if(.not.present(dieWith)) then
+	    if(present(perrWith)) write(stderr,'(4a)') perrWith, &
+		'" indexIA_() error, not found "',trim(item),'"'
+	  else
+	    write(stderr,'(4a)') dieWith,	&
+		'" indexIA_() error, not found "',trim(item),'"'
+	    call die(dieWith)
+	  endif
+	endif
+
+ end function indexIA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexRA_ - index the Accumulator real attribute list.
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the index in the real
+! accumulation register buffer of the {\tt Accumulator} argument {\tt aC} 
+! the attribute named by the {\tt CHARACTER} argument {\tt item}.  That
+! is, all the accumulator running tallies for the attribute named 
+! {\tt item} reside in 
+!\begin{verbatim}
+! aC%data%rAttr(indexRA_(aC,item),:).
+!\end{verbatim}
+! The user may request traceback information (e.g., the name of the 
+! routine from which this one is called) by providing values for either 
+! of the optional {\tt CHARACTER} arguments {\tt perrWith} or {\tt dieWith}
+! In the event {\tt indexRA\_()} can not find {\tt item} in {\tt aC}, 
+! the routine behaves as follows:
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexRA\_()} returns a value of zero;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ integer function indexRA_(aC, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+      use m_die,  only : die
+      use m_stdio,only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),          intent(in) :: aC
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 	14Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexRA_'
+
+  indexRA_=AttrVect_indexRA(aC%data,item)
+
+	if(indexRA_==0) then
+	  if(.not.present(dieWith)) then
+	    if(present(perrWith)) write(stderr,'(4a)') perrWith, &
+		'" indexRA_() error, not found "',trim(item),'"'
+	  else
+	    write(stderr,'(4a)') dieWith,	&
+		'" indexRA_() error, not found "',trim(item),'"'
+	    call die(dieWith)
+	  endif
+	endif
+
+ end function indexRA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportIAttr_ - Export INTEGER Attribute to a Vector
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt Accumulator} argument 
+! {\tt aC} the integer attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in 
+! the {\tt INTEGER} output array {\tt outVect}, and its length in the 
+! output {\tt INTEGER} argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt Accumulator} {\tt List} component {\tt aC\%data\%iList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportIAttr_(aC, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(Accumulator),      intent(in)  :: aC
+      character(len=*),       intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: outVect
+      integer,  optional,     intent(out) :: lsize
+
+! !REVISION HISTORY:
+
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportIAttr_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(lsize)) then
+     call AttrVect_exportIAttr(aC%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportIAttr(aC%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrSP_ - Export REAL Attribute to a Vector
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt Accumulator} argument 
+! {\tt aC} the real attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in 
+! the {\tt REAL} output array {\tt outVect}, and its length in the 
+! output {\tt INTEGER} argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt Accumulator} {\tt List} component {\tt aC\%data\%iList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportRAttrSP_(aC, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(Accumulator),      intent(in)  :: aC
+      character(len=*),       intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      real(SP), dimension(:), pointer     :: outVect
+      integer,  optional,     intent(out) :: lsize
+
+! !REVISION HISTORY:
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrSP_'
+
+       ! Export the data (inheritance from AttrVect)
+
+  if(present(lsize)) then
+     call AttrVect_exportRAttr(aC%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportRAttr(aC%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrDP_ - Export REAL Attribute to a Vector
+!
+! !DESCRIPTION:
+! Double precision version of exportRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine exportRAttrDP_(aC, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(Accumulator),      intent(in)  :: aC
+      character(len=*),       intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      real(DP), dimension(:), pointer     :: outVect
+      integer,  optional,    intent(out) :: lsize
+
+! !REVISION HISTORY:
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrDP_'
+
+       ! Export the data (inheritance from AttrVect)
+
+  if(present(lsize)) then
+     call AttrVect_exportRAttr(aC%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportRAttr(aC%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importIAttr_ - Import INTEGER Attribute from a Vector
+!
+! !DESCRIPTION:
+! This routine imports data provided in the input {\tt INTEGER} vector 
+! {\tt inVect} into the {\tt Accumulator} argument {\tt aC}, storing 
+! it as the integer attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}.  The input 
+! {\tt INTEGER} argument {\tt lsize} is used to ensure there is 
+! sufficient space in the {\tt Accumulator} to store the data.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt Accumulator} {\tt List} component {\tt aC\%data\%rList}.
+!
+! !INTERFACE:
+
+ subroutine importIAttr_(aC, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio ,        only : stderr
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),       intent(in)    :: AttrTag
+      integer, dimension(:),  pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(Accumulator),      intent(inout) :: aC
+
+! !REVISION HISTORY:
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importIAttr_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(aC)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(aC).', &
+          'lsize = ',lsize,'lsize_(aC) = ',lsize_(ac)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(aC%data, AttrTag, inVect, lsize)
+
+ end subroutine importIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrSP_ - Import REAL Attribute from a Vector
+!
+! !DESCRIPTION:
+! This routine imports data provided in the input {\tt REAL} vector 
+! {\tt inVect} into the {\tt Accumulator} argument {\tt aC}, storing 
+! it as the real attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}.  The input 
+! {\tt INTEGER} argument {\tt lsize} is used to ensure there is 
+! sufficient space in the {\tt Accumulator} to store the data.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt Accumulator} {\tt List} component {\tt aC\%data\%rList}.
+!
+! !INTERFACE:
+
+ subroutine importRAttrSP_(aC, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio ,        only : stderr
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),       intent(in)    :: AttrTag
+      real(SP), dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(Accumulator),      intent(inout) :: aC
+
+! !REVISION HISTORY:
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrSP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(aC)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(aC).', &
+          'lsize = ',lsize,'lsize_(aC) = ',lsize_(ac)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(aC%data, AttrTag, inVect, lsize)
+
+ end subroutine importRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrDP_ - Import REAL Attribute from a Vector
+!
+! !DESCRIPTION:
+! Double precision version of importRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine importRAttrDP_(aC, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio ,        only : stderr
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),       intent(in)    :: AttrTag
+      real(DP), dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(Accumulator),      intent(inout) :: aC
+
+! !REVISION HISTORY:
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrDP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(aC)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(aC).', &
+          'lsize = ',lsize,'lsize_(aC) = ',lsize_(ac)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(aC%data, AttrTag, inVect, lsize)
+
+ end subroutine importRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: zero_ - Zero an Accumulator
+!
+! !DESCRIPTION:
+! This subroutine clears the the {\tt Accumulator} argument {\tt aC}.  
+! This is accomplished by setting the number of completed steps in the
+! accumulation cycle to zero, and zeroing out all of the accumlation
+! registers.
+!
+! !INTERFACE:
+
+ subroutine zero_(aC)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(inout) :: aC
+
+! !REVISION HISTORY:
+!  7Aug02 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::zero_'
+
+	! Set number of completed cycle steps to zero:
+
+  aC%steps_done = 0
+
+	! Zero out the accumulation registers:
+
+  call AttrVect_zero(aC%data)
+
+ end subroutine zero_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: aCaCSharedAttrIndexList_ - Cross-index Two Accumulators
+!
+! !DESCRIPTION:  {\tt aCaCSharedAttrIndexList\_()} takes a pair of 
+! user-supplied {\tt Accumulator} variables {\tt aC1} and {\tt aC2}, 
+! and for choice of either {\tt REAL} or {\tt INTEGER} attributes (as
+! specified literally in the input {\tt CHARACTER} argument {\tt attrib})
+! returns the number of shared attributes {\tt NumShared}, and arrays of
+! indices {\tt Indices1} and {\tt Indices2} to their storage locations
+! in {\tt aC1} and {\tt aC2}, respectively.
+!
+! {\bf N.B.:}  This routine returns two allocated arrays---{\tt Indices1(:)} 
+! and {\tt Indices2(:)}---which must be deallocated once the user no longer
+! needs them.  Failure to do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine aCaCSharedAttrIndexList_(aC1, aC2, attrib, NumShared, &
+                                     Indices1, Indices2)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die,         only : MP_perr_die, die, warn
+
+      use m_List,     only : GetSharedListIndices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),    intent(in)  :: aC1   
+      type(Accumulator),    intent(in)  :: aC2
+      character*7,          intent(in)  :: attrib
+
+! !OUTPUT PARAMETERS:   
+!
+      integer,              intent(out) :: NumShared
+      integer,dimension(:), pointer     :: Indices1
+      integer,dimension(:), pointer     :: Indices2
+
+! !REVISION HISTORY:
+!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::aCaCSharedAttrIndexList_'
+
+  integer :: ierr
+
+       ! Based on the value of the argument attrib, pass the 
+       ! appropriate pair of Lists for comparison...
+
+  select case(trim(attrib))
+  case('REAL','real')
+     call GetSharedListIndices(aC1%data%rList, aC2%data%rList, NumShared, &
+                                 Indices1, Indices2)
+  case('INTEGER','integer')
+     call GetSharedListIndices(aC1%data%iList, aC2%data%iList, NumShared, &
+                                 Indices1, Indices2)
+  case default
+     write(stderr,'(4a)') myname_,":: value of argument attrib=",attrib, &
+          " not recognized.  Allowed values: REAL, real, INTEGER, integer"
+     ierr = 1
+     call die(myname_, 'invalid value for attrib', ierr)
+  end select
+
+ end subroutine aCaCSharedAttrIndexList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: aVaCSharedAttrIndexList_ - Cross-index with an AttrVect
+!
+! !DESCRIPTION:  {\tt aVaCSharedAttrIndexList\_()} a user-supplied 
+! {\tt AttrVect} variable {\tt aV} and an {\tt Accumulator} variable 
+! {\tt aC}, and for choice of either {\tt REAL} or {\tt INTEGER} 
+! attributes (as ! specified literally in the input {\tt CHARACTER} 
+! argument {\tt attrib}) returns the number of shared attributes 
+! {\tt NumShared}, and arrays of indices {\tt Indices1} and {\tt Indices2} 
+! to their storage locations in {\tt aV} and {\tt aC}, respectively.
+!
+! {\bf N.B.:}  This routine returns two allocated arrays---{\tt Indices1(:)} 
+! and {\tt Indices2(:)}---which must be deallocated once the user no longer
+! needs them.  Failure to do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine aVaCSharedAttrIndexList_(aV, aC, attrib, NumShared, &
+                                     Indices1, Indices2)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die,         only : MP_perr_die, die, warn
+
+      use m_AttrVect,    only : AttrVect
+
+      use m_List,     only : GetSharedListIndices
+
+ 
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),       intent(in)  :: aV   
+      type(Accumulator),    intent(in)  :: aC
+      character(len=*),     intent(in)  :: attrib
+
+! !OUTPUT PARAMETERS:   
+!
+      integer,              intent(out) :: NumShared
+      integer,dimension(:), pointer     :: Indices1
+      integer,dimension(:), pointer     :: Indices2
+
+! !REVISION HISTORY:
+!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::aVaCSharedAttrIndexList_'
+
+  integer :: ierr
+
+       ! Based on the value of the argument attrib, pass the 
+       ! appropriate pair of Lists for comparison...
+
+  select case(trim(attrib))
+  case('REAL','real')
+     call GetSharedListIndices(aV%rList, aC%data%rList, NumShared, &
+                                 Indices1, Indices2)
+  case('INTEGER','integer')
+     call GetSharedListIndices(aV%iList, aC%data%iList, NumShared, &
+                                 Indices1, Indices2)
+  case default
+     write(stderr,'(4a)') myname_,":: value of argument attrib=",attrib, &
+          " not recognized.  Allowed values: REAL, real, INTEGER, integer"
+     ierr = 1
+     call die(myname_, 'invalid value for attrib', ierr)
+  end select
+
+ end subroutine aVaCSharedAttrIndexList_
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: accumulate_--Acumulate from an AttrVect to an Accumulator.
+!
+! !DESCRIPTION:
+! This routine performs time {\em accumlation} of data present in an
+! MCT field data {\tt AttrVect} variable {\tt aV} and combines it with
+! the running tallies stored in the MCT {\tt Accumulator} variable {\tt aC}.
+! This routine automatically identifies which 
+! fields are held in common by {\tt aV} and {\tt aC} and uses the 
+! accumulation action information stored in {\tt aC} to decide how
+! each field in {\tt aV} is to be combined into its corresponding 
+! running tally in {\tt aC}.  The accumulation operations currently 
+! supported are:
+! \begin {itemize}
+! \item {\tt MCT\_SUM}:  Add the current values in the {\tt Av} to the current values in {\tt Ac}.  
+! \item {\tt MCT\_AVG}:  Same as {\tt MCT\_SUM} except when {\tt steps\_done} is equal
+! to {\tt num\_steps} then perform one more sum and replaced with average. 
+! \end {itemize}
+! 
+! This routine also automatically increments the counter in {\tt aC} 
+! signifying the number of steps completed in the accumulation cycle.
+!
+! NOTE:  The user must reset (zero) the {\tt Accumulator} after the average
+! has been formed or the next call to {\tt accumulate} will add to the average.
+!
+! !INTERFACE:
+
+ subroutine accumulate_(aV, aC)
+
+!
+! !USES:
+!
+      use m_stdio, only : stdout,stderr
+      use m_die,   only : die
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),     intent(in)    :: aV      ! Input AttrVect
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator),  intent(inout) :: aC      ! Output Accumulator
+
+! !REVISION HISTORY:
+! 18Sep00 - J.W. Larson <larson@mcs.anl.gov> -- initial version.
+!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> -- General version.
+! 10Jun01 - E.T. Ong -- fixed divide-by-zero problem in integer
+!           attribute accumulation.
+! 27Jul01 - E.T. Ong <eong@mcs.anl.gov> -- removed action argument.
+!           Make compatible with new Accumulator type.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::accumulate_'
+
+! Overlapping attribute index number
+  integer :: num_indices
+
+! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: aCindices, aVindices
+  integer :: aCindex, aVindex
+
+! Error flag and loop indices
+  integer :: ierr, l, n
+
+! Averaging time-weighting factor:
+  real(FP) :: step_weight
+  integer :: num_steps
+
+! Character variable used as a data type flag:
+  character*7 :: data_flag
+
+        ! Sanity check of arguments:
+
+  if(lsize_(aC) /= AttrVect_lsize(aV)) then
+     write(stderr,'(2a,i8,a,i8)') myname_, &
+     ':: Mismatched Accumulator/AttrVect lengths. AttrVect_lsize(aV) = ',&
+     AttrVect_lsize(aV), 'lsize_(aC) = ',lsize_(aC)
+     call die(myname_)
+  endif
+
+  if(aC%num_steps == 0) then
+     write(stderr,'(2a)') myname,':: FATAL--Zero steps in accumulation cycle.'
+     call die(myname_)
+  endif
+
+        ! Set num_steps from aC:
+
+  num_steps = aC%num_steps
+
+        ! Accumulation of REAL attribute data:
+
+  if( associated(aC%rAction) ) then   ! if summing or avergaging reals... 
+        
+        ! Accumulate only if fields are present 
+
+     data_flag = 'REAL'
+     call aVaCSharedAttrIndexList_(aV, aC, data_flag, num_indices, &
+                                   aVindices, aCindices)
+
+     if(num_indices > 0) then
+        do n=1,num_indices
+           aVindex = aVindices(n)
+           aCindex = aCindices(n)
+
+           ! Accumulate if the action is MCT_SUM or MCT_AVG
+           if( (aC%rAction(aCindex) == MCT_SUM).or. &
+               (aC%rAction(aCindex) == MCT_AVG) ) then
+              do l=1,AttrVect_lsize(aV)
+                 aC%data%rAttr(aCindex,l) = aC%data%rAttr(aCindex,l) + &
+                      aV%rAttr(aVindex,l)
+              end do
+           endif
+        end do
+
+        deallocate(aVindices, aCindices, stat=ierr)
+        if(ierr /= 0) then
+	   write(stderr,'(2a,i8)') myname_, &
+		':: Error in first deallocate(aVindices...), ierr = ',ierr
+	   call die(myname_)
+	endif
+
+     endif ! if(num_indices > 0)
+
+  endif ! if( associated(aC%rAction) )
+
+
+        ! Accumulation of INTEGER attribute data:
+
+  if( associated(aC%iAction) ) then    ! if summing or avergaging ints... 
+
+        ! Accumulate only if fields are present
+
+
+     data_flag = 'INTEGER'
+     call aVaCSharedAttrIndexList_(aV, aC, data_flag, num_indices, &
+                                   aVindices, aCindices)
+
+     if(num_indices > 0) then
+
+        do n=1,num_indices
+           aVindex = aVindices(n)
+           aCindex = aCindices(n)
+
+           ! Accumulate if the action is MCT_SUM or MCT_AVG
+           if( (aC%iAction(aCindex) == MCT_SUM) .or. &
+               (aC%iAction(aCindex) == MCT_AVG) ) then
+              do l=1,AttrVect_lsize(aV)
+                 aC%data%iAttr(aCindex,l) = aC%data%iAttr(aCindex,l) + &
+                      aV%iAttr(aVindex,l)
+              end do
+           endif
+        end do
+
+        deallocate(aVindices, aCindices, stat=ierr)
+        if(ierr /= 0) then
+	   write(stderr,'(2a,i8)') myname_, &
+		':: Error in second deallocate(aVindices...), ierr = ',ierr
+	   call die(myname_)
+	endif
+
+     endif ! if(num_indices > 0)
+
+  endif ! if( associated(aC%iAction) )
+
+        ! Increment aC%steps_done:
+
+  aC%steps_done = aC%steps_done + 1
+
+        ! If we are at the end of an averaging period, compute the
+        ! average (if desired).
+
+  if(aC%steps_done == num_steps) then
+
+     step_weight = 1.0_FP / REAL(num_steps,FP)
+     do n=1,nRAttr_(aC)
+        if( aC%rAction(n) == MCT_AVG ) then
+           do l=1,lsize_(aC)
+              aC%data%rAttr(n,l) = step_weight * aC%data%rAttr(n,l)
+           enddo
+        endif
+     enddo
+     
+     do n=1,nIAttr_(aC)
+        if( aC%iAction(n) == MCT_AVG ) then
+           do l=1,lsize_(aC)
+              aC%data%iAttr(n,l) = aC%data%iAttr(n,l) / num_steps
+           enddo
+        endif
+     enddo
+
+  endif
+
+ end subroutine accumulate_
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: average_ -- Force an average to be taken on an Accumulator
+!
+! !DESCRIPTION:
+! This routine will compute the average of the current values in an
+! {\tt Accumulator} using the current value of {\tt steps\_done}
+! in the {\tt Accumulator}
+!
+! !INTERFACE:
+
+ subroutine average_(aC)
+
+!
+! !USES:
+!
+      use m_stdio, only : stdout,stderr
+      use m_die,   only : die
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator),  intent(inout) :: aC      ! Output Accumulator
+
+! !REVISION HISTORY:
+! 11Jan08 - R.Jacob <jacob@mcs.anl.gov> -- initial version based on accumulate_
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::average_'
+
+! Overlapping attribute index number
+  integer :: num_indices
+
+! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: aCindices, aVindices
+  integer :: aCindex, aVindex
+
+! Error flag and loop indices
+  integer :: ierr, l, n
+
+! Averaging time-weighting factor:
+  real(FP) :: step_weight
+  integer :: steps_done
+
+
+  if(aC%num_steps == 0) then
+     write(stderr,'(2a)') myname_,':: FATAL--Zero steps in accumulation cycle.'
+     call die(myname_)
+  endif
+
+  if(aC%steps_done == 0) then
+     write(stderr,'(2a)') myname_,':: FATAL--Zero steps completed in accumulation cycle.'
+     call die(myname_)
+  endif
+
+        ! Set num_steps from aC:
+
+  steps_done = aC%steps_done
+
+
+   step_weight = 1.0_FP / REAL(steps_done,FP)
+   do n=1,nRAttr_(aC)
+      do l=1,lsize_(aC)
+         aC%data%rAttr(n,l) = step_weight * aC%data%rAttr(n,l)
+      enddo
+   enddo
+     
+   do n=1,nIAttr_(aC)
+       do l=1,lsize_(aC)
+          aC%data%iAttr(n,l) = aC%data%iAttr(n,l) / steps_done
+       enddo
+   enddo
+
+
+ end subroutine average_
+
+ end module m_Accumulator
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AccumulatorComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AccumulatorComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AccumulatorComms.F90	(revision 4775)
@@ -0,0 +1,803 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_AccumulatorComms.F90,v 1.12 2004-04-21 22:16:31 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_AccumulatorComms - MPI Communication Methods for the Accumulator
+!          
+!
+! !DESCRIPTION:
+!
+! This module contains communications methods for the {\tt Accumulator}
+! datatype (see {\tt m\_Accumulator} for details).  MCT's communications 
+! are implemented in terms of the Message Passing Interface (MPI) standard, 
+! and we have as best as possible, made the interfaces to these routines 
+! appear as similar as possible to the corresponding MPI routines.  For the 
+! { \tt Accumulator}, we currently support only the following collective 
+! operations: broadcast, gather, and scatter.  The gather and scatter 
+! operations rely on domain decomposition descriptors that are defined
+! elsewhere in MCT:  the {\tt GlobalMap}, which is a one-dimensional 
+! decomposition (see the MCT module {\tt m\_GlobalMap} for more details); 
+! and the {\tt GlobalSegMap}, which is a segmented decomposition capable
+! of supporting multidimensional domain decompositions (see the MCT module 
+! {\tt m\_GlobalSegMap} for more details).
+!
+! !INTERFACE:
+
+ module m_AccumulatorComms
+!
+! !USES:
+!
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+! List of communications Methods for the Accumulator class
+
+      public :: gather		! gather all local vectors to the root
+      public :: scatter		! scatter from the root to all PEs
+      public :: bcast		! bcast from root to all PEs
+
+! Definition of interfaces for the communication methods for 
+! the Accumulator:
+
+    interface gather ; module procedure &
+              GM_gather_, &
+              GSM_gather_ 
+    end interface
+    interface scatter ; module procedure &
+              GM_scatter_, &
+              GSM_scatter_ 
+    end interface
+    interface bcast  ; module procedure bcast_  ; end interface
+
+! !REVISION HISTORY:
+! 31Oct00 - Jay Larson <larson@mcs.anl.gov> - initial prototype--
+!           These routines were separated from the module m_Accumulator
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Specification of 
+!           APIs for the routines GSM_gather_() and GSM_scatter_().
+! 10May01 - Jay Larson <larson@mcs.anl.gov> - Changes in the
+!           comms routine to match the MPI model for collective
+!           communications, and general clean-up of prologues.
+!  9Aug01 - E.T. Ong <eong@mcs.anl.gov> - Added private routine
+!           bcastp_. Used new Accumulator routines initp_ and 
+!           initialized_ to simplify the routines.
+!  26Aug02 - E.T. Ong <eong@mcs.anl.gov> - thourough code revision; 
+!            no added routines
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_AccumulatorComms'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_gather_ - Gather Accumulator Distributed by a GlobalMap
+!
+! !DESCRIPTION:  {\tt GM\_gather()} takes a distributed (across the
+! communicator associated with the handle {\tt comm}) input 
+! {\tt Accumulator} argument {\tt iC} and gathers its data to the
+! {\tt Accumulator} {\tt oC} on the {\tt root}.  The decomposition of 
+! {\tt iC} is described by the input {\tt GlobalMap} argument {\tt Gmap}.
+! The success (failure) of this operation is signified by the zero (nonzero) 
+! value of the optional output argument {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine GM_gather_(iC, oC, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalMap, only : GlobalMap
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initialized => initialized
+      use m_Accumulator, only : Accumulator_initv => init
+      use m_AttrVectComms, only : AttrVect_gather => gather
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator), intent(in)  :: iC
+      type(GlobalMap) ,  intent(in)  :: GMap
+      integer,           intent(in)  :: root
+      integer,           intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(out) :: oC
+      integer, optional,intent(out)  :: stat
+
+! !REVISION HISTORY:
+! 13Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 31Oct00 - Jay Larson <larson@mcs.anl.gov> - relocated to the
+!           module m_AccumulatorComms
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - renamed GM_gather_
+! 10May01 - Jay Larson <larson@mcs.anl.gov> - revamped comms 
+!           model to match MPI comms model, and cleaned up prologue
+!  9Aug01 - E.T. Ong <eong@mcs.anl.gov> - 2nd prototype. Used the 
+!           intiialized_ and accumulator init routines.
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::GM_gather_'
+ integer :: myID, ier, i
+ logical :: status
+
+        ! Initialize status flag (if present)
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm, myID, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! Argument check of iC: kill if iC is not initialized 
+        ! on all processes
+
+  status = Accumulator_initialized(iC,die_flag=.true.,source_name=myname_)
+
+        ! NOTE: removed argument check for oC on the root. 
+        ! Is there any good way to check if an accumulator is NOT initialized? 
+
+        ! Initialize oC from iC. Clean oC%data - we don't want this av.
+
+  if(myID == root) then
+     
+     call Accumulator_initv(oC,iC,lsize=1, &
+                            num_steps=iC%num_steps,steps_done=iC%steps_done)
+     call AttrVect_clean(oC%data)
+
+  endif
+
+       ! Initialize oC%data. Gather distributed iC%data to oC%data on the root
+
+  call AttrVect_gather(iC%data, oC%data, GMap, root, comm, ier)
+
+  if(ier /= 0) then
+    call perr(myname_,'AttrVect_gather(iC%data, oC%data...',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+        ! Check oC to see if its valid
+  
+  if(myID == root) then
+     status = Accumulator_initialized(oC,die_flag=.true.,source_name=myname_)
+  endif
+
+ end subroutine GM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_gather_ - Gather Accumulator Distributed by a GlobalSegMap
+!
+! !DESCRIPTION:  This routine takes the distrubuted (on the communcator
+! associated with the handle {\tt comm}) input {\tt Accumulator} 
+! argument {\tt iC} gathers it to the the {\tt Accumulator} argument 
+! {\tt oC} (valid only on the {\tt root}).  The decompositon of {\tt iC}
+! is contained in the input {\tt GlobalSegMap} argument {\tt GSMap}.  
+! The success (failure) of this operation is signified by the zero 
+! (nonzero) returned value of the {\tt INTEGER} flag {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine GSM_gather_(iC, oC, GSMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initv => init
+      use m_Accumulator,   only : Accumulator_initialized => initialized
+      use m_AttrVectComms, only : AttrVect_gather => gather
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),  intent(in) :: iC
+      type(GlobalSegMap), intent(in) :: GSMap
+      integer,            intent(in) :: root
+      integer,            intent(in) :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(out) :: oC
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+! 	15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 	10May01 - Jay Larson <larson@mcs.anl.gov> - Initial code and
+!                 cleaned up prologue.
+!       09Aug01 - E.T. Ong <eong@mcs.anl.gov> - 2nd prototype. Used the 
+!                 intiialized_ and accumulator init routines.
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::GSM_gather_'
+ integer :: myID, ier, i
+ logical :: status
+
+        ! Initialize status flag (if present)
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm, myID, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! Argument check of iC 
+
+  status = Accumulator_initialized(iC,die_flag=.true.,source_name=myname_)
+
+        ! NOTE: removed argument check for oC on the root. 
+        ! Is there any good way to check if an accumulator is NOT initialized? 
+
+        ! Initialize oC from iC. Clean oC%data - we don't want this av.
+
+  if(myID == root) then
+     call Accumulator_initv(oC,iC,lsize=1, &
+                            num_steps=iC%num_steps,steps_done=iC%steps_done)
+     call AttrVect_clean(oC%data)
+  endif
+
+       ! Gather distributed iC%data to oC%data on the root
+
+  call AttrVect_gather(iC%data, oC%data, GSMap, root, comm, ier)
+  
+  if(ier /= 0) then
+    call perr(myname_,'AttrVect_gather(iC%data, oC%data...',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+        ! Check oC to see if its valid
+
+  if(myID == root) then
+     status = Accumulator_initialized(oC,die_flag=.true.,source_name=myname_)
+  endif
+  
+
+ end subroutine GSM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_scatter_ - Scatter an Accumulator using a GlobalMap
+!
+! !DESCRIPTION:  This routine takes the input {\tt Accumulator} argument
+! {\tt iC} (valid only on the {\tt root}), and scatters it to the 
+! distributed {\tt Accumulator} argument {\tt oC} on the processes 
+! associated with the communicator handle {\tt comm}.  The decompositon
+! used to scatter the data is contained in the input {\tt GlobalMap} 
+! argument {\tt GMap}.  The success (failure) of this operation is 
+! signified by the zero (nonzero) returned value of the {\tt INTEGER} 
+! flag {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine GM_scatter_(iC, oC, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalMap,   only : GlobalMap
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initv => init
+      use m_Accumulator, only : Accumulator_initialized => initialized
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVectComms, only : AttrVect_scatter => scatter
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator), intent(in)  :: iC
+      type(GlobalMap),   intent(in)  :: GMap
+      integer,           intent(in)  :: root
+      integer,           intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(out) :: oC
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+! 	14Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 	31Oct00 - Jay Larson <larson@mcs.anl.gov> - moved from the module
+!                 m_Accumulator to m_AccumulatorComms
+! 	15Jan01 - Jay Larson <larson@mcs.anl.gov> - renamed GM_scatter_.
+!       10May01 - Jay Larson <larson@mcs.anl.gov> - revamped code to fit
+!                 MPI-like comms model, and cleaned up prologue.
+!       09Aug01 - E.T. Ong <eong@mcs.anl.gov> - 2nd prototype. Used the  
+!                 initialized_, Accumulator init_, and bcastp_ routines.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GM_scatter_'
+
+  integer :: myID, ier
+  logical :: status
+
+        ! Initialize status flag (if present)
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm, myID, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! Argument check of iC 
+
+  if(myID==root) then
+     status = Accumulator_initialized(iC,die_flag=.true.,source_name=myname_)
+  endif
+
+        ! NOTE: removed argument check for oC on all processes. 
+        ! Is there any good way to check if an accumulator is NOT initialized? 
+
+        ! Copy accumulator from iC to oC
+        ! Clean up oC%data on root. 
+
+  if(myID == root) then
+     call Accumulator_initv(oC,iC,lsize=1,num_steps=iC%num_steps, &
+                            steps_done=iC%steps_done)
+     call AttrVect_clean(oC%data)
+  endif
+
+        ! Broadcast oC (except for oC%data)
+
+  call bcastp_(oC, root, comm, stat)
+
+	! Scatter the AttrVect component of iC
+
+  call AttrVect_scatter(iC%data, oC%data, GMap, root, comm, ier)
+
+  if(ier /= 0) then
+    call perr(myname_,'AttrVect_scatter(iC%data, oC%data...',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+        ! Check oC to see if its valid
+
+  status = Accumulator_initialized(oC,die_flag=.true.,source_name=myname_)
+
+ end subroutine GM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_scatter_ - Scatter an Accumulator using a GlobalSegMap
+!
+! !DESCRIPTION:  This routine takes the input {\tt Accumulator} argument
+! {\tt iC} (valid only on the {\tt root}), and scatters it to the 
+! distributed {\tt Accumulator} argument {\tt oC} on the processes 
+! associated with the communicator handle {\tt comm}.  The decompositon
+! used to scatter the data is contained in the input {\tt GlobalSegMap} 
+! argument {\tt GSMap}.  The success (failure) of this operation is 
+! signified by the zero (nonzero) returned value of the {\tt INTEGER} 
+! flag {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine GSM_scatter_(iC, oC, GSMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initv => init
+      use m_Accumulator, only : Accumulator_initialized => initialized
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVectComms, only : AttrVect_scatter => scatter
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(Accumulator),  intent(in)  :: iC
+      type(GlobalSegMap), intent(in)  :: GSMap
+      integer,            intent(in)  :: root
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(Accumulator),  intent(out) :: oC
+      integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY:
+! 	15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 	10May01 - Jay Larson <larson@mcs.anl.gov> - Initial code/prologue
+!       09Aug01 - E.T. Ong <eong@mcs.anl.gov> 2nd prototype. Used the
+!                 initialized and accumulator init routines.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GSM_scatter_'
+
+  integer :: myID, ier
+  logical :: status
+
+        ! Initialize status flag (if present)
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm, myID, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! Argument check of iC 
+
+  if(myID == root) then
+     status = Accumulator_initialized(iC,die_flag=.true.,source_name=myname_)
+  endif
+
+        ! NOTE: removed argument check for oC on all processes. 
+        ! Is there any good way to check if an accumulator is NOT initialized? 
+  
+        ! Copy accumulator from iC to oC
+        ! Clean up oC%data on root. 
+
+  if(myID == root) then
+     call Accumulator_initv(oC,iC,lsize=1,num_steps=iC%num_steps, &
+                            steps_done=iC%steps_done)
+     call AttrVect_clean(oC%data)
+  endif
+
+        ! Broadcast oC (except for oC%data)
+
+  call bcastp_(oC, root, comm, stat)
+
+	! Scatter the AttrVect component of aC
+
+  call AttrVect_scatter(iC%data, oC%data, GSMap, root, comm, ier)
+
+  if(ier /= 0) then
+    call perr(myname_,'AttrVect_scatter(iC%data, oC%data...',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+        ! Check oC if its valid
+
+  status = Accumulator_initialized(oC,die_flag=.true.,source_name=myname_)
+  
+
+ end subroutine GSM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - Broadcast an Accumulator
+!
+! !DESCRIPTION:  This routine takes the input {\tt Accumulator} argument
+! {\tt aC} (on input valid only on the {\tt root}), and broadcasts it 
+! to all the processes associated with the communicator handle 
+! {\tt comm}.  The success (failure) of this operation is signified by 
+! the zero (nonzero) returned value of the {\tt INTEGER} flag {\tt stat}.
+!
+! !INTERFACE:
+!
+ subroutine bcast_(aC, root, comm, stat)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+      use m_AttrVectComms, only : AttrVect_bcast => bcast
+
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initialized => initialized
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,intent(in) :: root
+      integer,intent(in) :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(inout) :: aC ! (IN) on root, (OUT) elsewhere
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 	14Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 	31Oct00 - Jay Larson <larson@mcs.anl.gov> - moved from the module
+!                 m_Accumulator to m_AccumulatorComms
+!       09May01 - Jay Larson <larson@mcs.anl.gov> - cleaned up prologue
+!       09Aug01 - E.T. Ong <eong@mcs.anl.gov> - 2nd prototype. Made use of
+!                 bcastp_ routine. Also more argument checks.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcast_'
+
+  integer :: myID
+  integer :: ier
+  logical :: status
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! Argument check : Kill if the root aC is not initialized,
+        ! or if the non-root aC is initialized
+
+  if(myID == root) then
+     status = Accumulator_initialized(aC,die_flag=.true.,source_name=myname_)
+  endif
+  
+        ! NOTE: removed argument check for aC on all non-root processes. 
+        ! Is there any good way to check if an accumulator is NOT initialized? 
+  
+  call bcastp_(aC, root, comm, stat)
+
+
+	! Broadcast the root value of aC%data
+
+  call AttrVect_bcast(aC%data, root, comm, ier)
+
+  if(ier /= 0) then
+    call perr(myname_,'AttrVect_bcast(aC%data)',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+        ! Check that aC on all processes are initialized
+
+  status = Accumulator_initialized(aC,die_flag=.true.,source_name=myname_)
+
+
+ end subroutine bcast_
+ 
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcastp_ - Broadcast an Accumulator (but Not its Registers)
+!
+! !DESCRIPTION:  This routine broadcasts all components of the accumulator 
+!                aC except for aC%data. This is a private routine, only meant
+!                to be used by accumulator scatter and gather routines.
+!                 
+!
+! !INTERFACE:
+!
+ subroutine bcastp_(aC, root, comm, stat)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+      use m_AttrVectComms, only : AttrVect_bcast => bcast
+      use m_Accumulator, only : Accumulator
+      use m_Accumulator, only : Accumulator_initp => initp
+      use m_Accumulator, only : Accumulator_nIAttr => nIAttr
+      use m_Accumulator, only : Accumulator_nRAttr => nRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,intent(in) :: root
+      integer,intent(in) :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(Accumulator), intent(inout) :: aC ! (IN) on root, (OUT) elsewhere
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+!       09Aug01 - E.T. Ong <eong@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcastp_'
+
+  integer :: myID
+  integer :: ier, i
+  integer :: aC_num_steps, aC_steps_done, aC_nIAttr, aC_nRAttr
+  integer :: FirstiActionIndex, LastiActionIndex
+  integer :: FirstrActionIndex, LastrActionIndex  
+  integer :: AccBuffSize
+  integer :: nIAttr, nRAttr
+  integer, dimension(:), allocatable :: AccBuff, aC_iAction, aC_rAction
+  logical :: status
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! STEP 1: Pack broadcast buffer.
+
+        ! On the root, load up the Accumulator Buffer: Buffer Size = 
+        ! num_steps {1} + steps_done {1} + nIAttr {1} + nRAttr {1} + 
+        ! iAction {nIAttr} + rAction {nRAttr}
+
+
+  if(myID == root) then
+
+     if(associated(aC%iAction)) then
+	nIAttr = size(aC%iAction)
+     else
+	nIAttr = 0
+     endif
+
+     if(associated(aC%rAction)) then
+	nRAttr = size(aC%rAction)
+     else
+	nRAttr = 0
+     endif
+
+     AccBuffSize = 4+nIAttr+nRAttr
+
+  endif
+
+        ! Use AccBuffSize to initialize AccBuff on all processes
+
+  call MPI_BCAST(AccBuffSize, 1, MP_INTEGER, root, comm, ier)
+
+  if(ier /= 0) call MP_perr_die(myname_,'AttrVect_bcast(AccBuffSize)',ier)
+
+  allocate(AccBuff(AccBuffSize),stat=ier)
+  if(ier /= 0) call MP_perr_die(myname_,"AccBuff allocate",ier)
+
+  if(myID == root) then
+
+        ! load up iC%num_steps and iC%steps_done
+  
+     AccBuff(1) = aC%num_steps
+     AccBuff(2) = aC%steps_done
+
+        ! Load up nIAttr and nRAttr
+
+     AccBuff(3) = nIAttr
+     AccBuff(4) = nRAttr
+
+        ! Load up aC%iAction (pointer copy)
+
+     do i=1,nIAttr
+	AccBuff(4+i) = aC%iAction(i)
+     enddo
+
+        ! Load up aC%rAction (pointer copy)
+
+     do i=1,nRAttr
+	AccBuff(4+nIAttr+i) = aC%rAction(i)
+     enddo
+  endif
+  
+        ! STEP 2: Broadcast 
+
+	! Broadcast the root value of AccBuff
+
+  call MPI_BCAST(AccBuff, AccBuffSize, MP_INTEGER, root, comm, ier)
+
+  if(ier /= 0) call MP_perr_die(myname_,'MPI_bcast(AccBuff...',ier)
+
+
+        ! STEP 3: Unpack broadcast buffer.
+
+        ! On all processes  unload aC_num_steps, aC_steps_done
+        ! aC_nIAttr, and aC_nRAttr from StepBuff
+
+  aC_num_steps  = AccBuff(1)
+  aC_steps_done = AccBuff(2)
+  aC_nIAttr = AccBuff(3)
+  aC_nRAttr = AccBuff(4)
+ 
+        ! Unload iC%iAction and iC%rAction
+
+  if(aC_nIAttr > 0) then
+     allocate(aC_iAction(aC_nIAttr),stat=ier)
+     if(ier /= 0) call die(myname_,"allocate aC_iAction",ier)
+     
+     FirstiActionIndex = 5
+     LastiActionIndex = 4+aC_nIAttr       
+     aC_iAction(1:aC_nIAttr) = AccBuff(FirstiActionIndex:LastiActionIndex)
+
+  endif
+
+  if(aC_nRAttr > 0) then
+     allocate(aC_rAction(aC_nRAttr),stat=ier)
+     if(ier /= 0) call die(myname_,"allocate aC_rAction",ier)
+
+     FirstrActionIndex = 5+aC_nIAttr
+     LastrActionIndex = 4+aC_nIAttr+aC_nRAttr
+     aC_rAction(1:aC_nRAttr) = AccBuff(FirstrActionIndex:LastrActionIndex)
+
+  endif
+
+	! Initialize aC on non-root processes
+
+  if( (aC_nIAttr > 0).and.(aC_nRAttr > 0) ) then
+
+     if(myID /= root) then
+	call Accumulator_initp(aC,iAction=aC_iAction,rAction=aC_rAction, &
+                               num_steps=aC_num_steps, &
+                               steps_done=aC_steps_done)
+     endif 
+
+     deallocate(aC_iAction,aC_rAction,stat=ier)
+     if(ier /= 0) call die(myname_,"deallocate aC_iAction...",ier)
+
+  else
+
+     if (aC_nIAttr > 0) then
+	if(myID /= root) then
+	   call Accumulator_initp(aC,iAction=aC_iAction, &
+                                  num_steps=aC_num_steps, &
+                                  steps_done=aC_steps_done)
+	endif
+	deallocate(aC_iAction,stat=ier)
+	if(ier /= 0) call die(myname_,"deallocate aC_iAction...",ier)
+     endif
+
+     if (aC_nRAttr > 0) then
+	if(myID /= root) then
+	   call Accumulator_initp(aC,rAction=aC_rAction, &
+                                  num_steps=aC_num_steps, &
+                                  steps_done=aC_steps_done)
+	endif
+	deallocate(aC_rAction,stat=ier)
+	if(ier /= 0) call die(myname_,"deallocate aC_iAction...",ier)
+     endif
+
+  endif
+
+  ! Clean up allocated arrays
+
+  deallocate(AccBuff,stat=ier)
+  if(ier /= 0) call die(myname_,"deallocate(AccBuff)",ier)
+
+
+ end subroutine bcastp_
+ 
+
+ end module m_AccumulatorComms
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVect.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVect.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVect.F90	(revision 4775)
@@ -0,0 +1,4064 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!-----------------------------------------------------------------------
+! CVS m_AttrVect.F90,v 1.86 2012-04-27 20:01:04 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_AttrVect - Multi-field Storage
+!
+! !DESCRIPTION:
+!
+! An {\em attribute vector} is a scheme for storing bundles of integer 
+! and real data vectors, indexed by the names of the fields stored in 
+! {\tt List} format (see the mpeu module {\tt m\_List} for more 
+! information about the {\tt List} datatype).  The ordering of the 
+! fieldnames in the integer and real attribute {\tt List} components 
+! ({\tt AttrVect\%iList} and {\tt AttrVect\%rList}, respectively) 
+! corresponds to the storage order of the attributes in their respective 
+! data buffers (the components {\tt AttrVect\%iAttr(:,:)} and 
+! {\tt AttrVect\%rAttr(:,:)}, respectively).   The organization of 
+! the fieldnames in {\tt List} format, along with the direct mapping
+! between {\tt List} items and locations in the data buffer, allows 
+! the user to have {\em random access} to the field data.  This 
+! approach also allows the user to set the number and the names of fields 
+! stored in an {\tt AttrVect} at run-time.  
+!
+! The {\tt AttrVect} stores field data in a {\em pointwise} fashion 
+! (that is, the data are grouped so that all the integer or real data 
+! associated with an individual point are adjacent to each other in memory. 
+! This amounts to the having the integer and real field data arrays in 
+! the {\tt AttrVect} (the components {\tt AttrVect\%iAttr(:,:)} and 
+! {\tt AttrVect\%rAttr(:,:)}, respectively) having the attribute index
+! as the major (or fastest-varying) index.  A prime example of this is 
+! observational data input to a data assimilation system.  In the Model 
+! Coupling Toolkit, this datatype is the fundamental type for storing 
+! field data exchanged by component models, and forms a basis for other
+! MCT datatypes that encapsulate time accumulation/averaging buffers (the 
+! {\tt Accumulator} datatype defined in the module {\tt m\_Accumulator}), 
+! coordinate grid information (the {\tt GeneralGrid} datatype defined in 
+! the module {\tt m\_GeneralGrid}), and sparse interpolation matrices
+! (the {\tt SparseMatrix} datatype defined in the module 
+! {\tt m\_SparseMatrix}).
+!
+! The attribute vector is implemented in Fortran 90 using the 
+! {\tt AttrVect} derived type.  This module contains the definition 
+! of the {\tt AttrVect}, and the numerous methods that service it.  There
+! are a number of initialization (creation) schemes, and a routine for 
+! zeroing out the elements of an {\tt AttrVect}.  There is a method 
+! to {\em clean} up allocated memory used by an {\tt AttrVect} 
+! (destruction).  There are numerous query methods that return:  the 
+! number of datapoints (or {\em length}; the numbers of integer and 
+! real attributes; the data buffer index of a given real or integer 
+! attribute; and return the lists of real and integer attributes.  There 
+! also exist methods for exporting a given attribute as a one-dimensional
+! array and importing a given attribute from a one-dimensional array.  
+! There is a method for copying attributes from one {\tt AttrVect} to 
+! another.  There is also a method for cross-indexing the attributes in 
+! two {\tt AttrVect} variables.  In addition, there are methods that
+! return those cross-indexed attributes along with some auxiliary data
+! in a {\tt AVSharedIndicesOneType} or {\tt AVSharedIndices} structure.
+! Finally, there are methods for sorting and permuting {\tt AttrVect}
+! entries using a MergeSort scheme keyed by the attributes of the {\tt
+! AttrVect}.
+!
+! !INTERFACE:
+
+ module m_AttrVect
+!
+! !USES:
+!
+      use m_realkinds,only : SP,DP,FP          ! Real types definitions
+
+      use m_List, only : List   ! Support for rList and iList components.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: AttrVect        ! The class data structure
+      public :: AVSharedIndicesOneType ! Data structure recording shared indices between
+                                       ! two attribute vectors, for a single data type
+                                       ! (e.g., shared real attributes)
+      public :: AVSharedIndices ! Data structure recording shared indices between two
+                                ! attribute vectors, for all data types
+
+    type AttrVect
+#ifdef SEQUENCE
+      sequence
+#endif
+      type(List) :: iList
+      type(List) :: rList
+      integer,dimension(:,:),pointer :: iAttr
+      real(FP) ,dimension(:,:),pointer :: rAttr
+    end type AttrVect
+
+    type AVSharedIndicesOneType
+       integer :: num_indices           ! number of shared items
+       logical :: contiguous            ! true if index segments are contiguous in memory
+       character*7 :: data_flag         ! data type flag (e.g., 'REAL' or 'INTEGER')
+
+       ! arrays of indices to storage locations of shared attributes between the two
+       ! attribute vectors: 
+       integer, dimension(:), pointer :: aVindices1
+       integer, dimension(:), pointer :: aVindices2
+    end type AVSharedIndicesOneType
+
+    type AVSharedIndices
+       type(AVSharedIndicesOneType) :: shared_real     ! shared indices of type REAL
+       type(AVSharedIndicesOneType) :: shared_integer  ! shared indices of type INTEGER
+    end type AVSharedIndices
+       
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init		! create a local vector
+      public :: clean		! clean the local vector
+      public :: zero		! zero the local vector
+      public :: lsize		! size of the local vector
+      public :: nIAttr		! number of integer attributes on local
+      public :: nRAttr		! number of real attributes on local
+      public :: indexIA		! index the integer attributes
+      public :: indexRA		! index the real attributes
+      public :: getIList        ! return list of integer attributes
+      public :: getRList        ! return list of real attributes
+      public :: exportIList     ! export INTEGER attibute List
+      public :: exportRList     ! export REAL attibute List
+      public :: exportIListToChar ! export INTEGER attibute List as Char
+      public :: exportRListToChar ! export REAL attibute List as Char
+      public :: appendIAttr     ! append INTEGER attribute List
+      public :: appendRAttr     ! append REAL attribute List
+      public :: exportIAttr     ! export INTEGER attribute to vector
+      public :: exportRAttr     ! export REAL attribute to vector
+      public :: importIAttr     ! import INTEGER attribute from vector
+      public :: importRAttr     ! import REAL attribute from vector
+      public :: Copy		! copy attributes from one Av to another
+      public :: RCopy		! copy real attributes from one Av to another
+      public :: ICopy		! copy integer attributes from one Av to another
+      public :: Sort            ! sort entries, and return permutation
+      public :: Permute         ! permute entries
+      public :: Unpermute       ! Unpermute entries
+      public :: SortPermute     ! sort and permute entries
+      public :: SharedAttrIndexList  ! Cross-indices of shared
+                                     ! attributes of two AttrVects
+      public :: SharedIndices        ! Given two AttrVects, create an AVSharedIndices structure
+      public :: SharedIndicesOneType ! Given two AttrVects, create an
+                                     ! AVSharedIndicesOneType structure for a single type
+      public :: cleanSharedIndices   ! clean a AVSharedIndices structure
+      public :: cleanSharedIndicesOneType  ! clean a AVSharedIndicesOneType structure
+
+
+    interface init   ; module procedure	&
+       init_,  &
+       initv_, &
+       initl_
+    end interface
+    interface clean  ; module procedure clean_  ; end interface
+    interface zero  ; module procedure zero_  ; end interface
+    interface lsize  ; module procedure lsize_  ; end interface
+    interface nIAttr ; module procedure nIAttr_ ; end interface
+    interface nRAttr ; module procedure nRAttr_ ; end interface
+    interface indexIA; module procedure indexIA_; end interface
+    interface indexRA; module procedure indexRA_; end interface
+    interface getIList; module procedure getIList_; end interface
+    interface getRList; module procedure getRList_; end interface
+    interface exportIList; module procedure exportIList_; end interface
+    interface exportRList; module procedure exportRList_; end interface
+    interface exportIListToChar
+       module procedure exportIListToChar_
+    end interface
+    interface exportRListToChar
+       module procedure exportRListToChar_
+    end interface
+    interface appendIAttr  ; module procedure appendIAttr_  ; end interface
+    interface appendRAttr  ; module procedure appendRAttr_  ; end interface
+    interface exportIAttr; module procedure exportIAttr_; end interface
+    interface exportRAttr; module procedure &
+       exportRAttrSP_, &
+       exportRAttrDP_
+    end interface
+    interface importIAttr; module procedure importIAttr_; end interface
+    interface importRAttr; module procedure &
+         importRAttrSP_, &
+         importRAttrDP_
+    end interface
+    interface Copy    ; module procedure Copy_    ; end interface
+    interface RCopy   ; module procedure  &
+         RCopy_, &
+         RCopyL_
+    end interface
+    interface ICopy   ; module procedure  &
+          ICopy_, &
+          ICopyL_
+    end interface
+    interface Sort    ; module procedure Sort_    ; end interface
+    interface Permute ; module procedure Permute_ ; end interface
+    interface Unpermute ; module procedure Unpermute_ ; end interface
+    interface SortPermute ; module procedure SortPermute_ ; end interface
+    interface SharedAttrIndexList ; module procedure &
+        aVaVSharedAttrIndexList_ 
+    end interface
+    interface SharedIndices ; module procedure SharedIndices_ ; end interface
+    interface SharedIndicesOneType ; module procedure SharedIndicesOneType_ ; end interface
+    interface cleanSharedIndices ; module procedure cleanSharedIndices_ ; end interface
+    interface cleanSharedIndicesOneType ; module procedure cleanSharedIndicesOneType_ ; end interface
+
+! !REVISION HISTORY:
+! 10Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct00 - J.W. Larson <larson@mcs.anl.gov> - made getIList
+!           and getRList functions public and added appropriate
+!           interface definitions
+! 20Oct00 - J.W. Larson <larson@mcs.anl.gov> - added Sort, 
+!           Permute, and SortPermute functions.
+! 09May01 - J.W. Larson <larson@mcs.anl.gov> - added initl_().
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - added routines 
+!           exportIattr(), exportRAttr(), importIAttr(), 
+!           and importRAttr().  Also cleaned up module and 
+!           routine prologues.
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - made importIAttr()
+!           and importRAttr() public (bug fix).
+! 14Dec01 - J.W. Larson <larson@mcs.anl.gov> - added exportIList()
+!           and exportRList().
+! 14Feb02 - J.W. Larson <larson@mcs.anl.gov> - added CHARCTER
+!           functions exportIListToChar() and exportRListToChar()
+! 26Feb02 - J.W. Larson <larson@mcs.anl.gov> - corrected of usage
+!           of m_die routines throughout this module.
+! 16Apr02 - J.W. Larson <larson@mcs.anl.gov> - added the method
+!           LocalReduce(), and the public data members AttrVectSUM,
+!           AttrVectMIN, and AttrVectMAX.
+! 7May02 - J.W. Larson <larson@mcs.anl.gov> - Refactoring.  Moved
+!          LocalReduce() and the public data members AttrVectSUM,
+!           AttrVectMIN, and AttrVectMAX to a new module named
+!           m_AttrVectReduce.
+! 12Jun02 - R.L. Jacob <jacob@mcs.anl.gov> - add Copy function
+! 13Jun02 - R.L. Jacob <jacob@mcs.anl.gov> - move aVavSharedAttrIndexList
+!           to this module from old m_SharedAttrIndicies
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - added AVSharedIndices and
+!           AVSharedIndicesOneType derived types, and associated
+!           subroutines
+! 10Apr12 - W.J. Sacks <sacks@ucar.edu> - modified AVSharedIndices code
+!           to be Fortran-90 compliant
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_AttrVect'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Initialize an AttrVect Given Attribute Lists and Length
+!
+! !DESCRIPTION:
+! This routine creates an {\tt AttrVect} (the output argument {\tt aV}) 
+! using the optional input {\tt CHARACTER} arguments {\tt iList}, and 
+! {\tt rList} to define its integer and real attributes, respectively.
+! The optional input {\tt INTEGER} argument {\tt lsize} defines the 
+! number of points for which we are storing attributes, or the 
+! {\em length} of {\tt aV}.  The expected form for the arguments 
+! {\tt iList} and {\tt rList} are colon-delimited strings where each
+! substring defines an attribute.  Suppose we wish to store {\tt N} 
+! observations that have the real attributes {\tt 'latitude'}, 
+! {\tt 'longitude'}, {\tt pressure}, {\tt 'u-wind'}, and 
+! {\tt 'v-wind'}.  Suppose we also wish to store the integer 
+! attributes {\tt 'hour'}, {\tt 'day'}, {\tt 'month'}, {\tt 'year'}, 
+! and {\tt 'data source'}.  This can be accomplished by invoking 
+! {\tt init\_()} as follows:
+! \begin{verbatim} 
+! call init_(aV, 'hour:day:month:year:data source', &
+!            'latitude:longitude:pressure:u-wind:v-wind', N)
+! \end{verbatim} 
+! The resulting {\tt AttrVect} {\tt aV} will have five integer 
+! attributes, five real attributes, and length {\tt N}.
+!
+! !INTERFACE:
+
+ subroutine init_(aV, iList, rList, lsize)
+!
+! !USES:
+!
+      use m_List, only : List
+      use m_List, only : init,nitem
+      use m_List, only : List_nullify => nullify
+      use m_mall
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*), optional, intent(in)  :: iList
+      character(len=*), optional, intent(in)  :: rList
+      integer,          optional, intent(in)  :: lsize
+
+! !OUTPUT PARAMETERS: 
+!
+      type(AttrVect),             intent(out) :: aV
+
+! !REVISION HISTORY:
+! 09Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 09Oct01 - J.W. Larson <larson@mcs.anl.gov> - added feature to
+!           nullify all pointers before usage.  This was done to
+!           accomodate behavior of the f90 ASSOCIATED intrinsic 
+!           function on the AIX platform.
+! 07Dec01 - E.T. Ong <eong@mcs.anl.gov> - added support for 
+!           intialization with blank character strings for iList
+!           and rList
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::init_'
+  integer :: nIA,nRA,n,ier
+
+       ! Initially, nullify all pointers in the AttrVect aV:
+
+  nullify(aV%iAttr)
+  nullify(aV%rAttr)
+  call List_nullify(aV%iList)
+  call List_nullify(aV%rList)
+
+  if(present(rList)) then
+     if(len_trim(rList) > 0) then
+	call init(aV%rList,rList)	! init.List()
+     endif
+  endif
+
+  if(present(iList)) then
+     if(len_trim(iList) > 0) then
+	call init(aV%iList,iList)	! init.List()
+     endif
+  endif
+
+  nIA=nitem(aV%iList)		! nitem.List()
+  nRA=nitem(aV%rList)		! nitem.List()
+
+  n=0
+  if(present(lsize)) n=lsize
+
+  allocate( aV%iAttr(nIA,n),aV%rAttr(nRA,n),	stat=ier)
+  if(ier /= 0) call die(myname_,'allocate()',ier)
+
+#ifdef MALL_ON
+	call mall_ci(size(transfer(aV%iAttr,(/1/)),myname_)
+	call mall_ci(size(transfer(aV%rAttr,(/1/)),myname_)
+#endif
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initv_ - Initialize One AttrVect from Another
+!
+! !DESCRIPTION:  This routine takes an input {\tt AttrVect} argument 
+! {\tt bV}, and uses its attribute list information to create an output
+! {\tt AttrVect} variable {\tt aV}.  The length of {\tt aV} is defined 
+! by the input {\tt INTEGER} argument {\tt lsize}.  
+!
+! !INTERFACE:
+
+ subroutine initv_(aV, bV, lsize)
+!
+! !USES:
+!
+      use m_String, only : String,char
+      use m_String, only : String_clean => clean    
+      use m_List,   only : get
+      use m_List,   only : List_nullify => nullify
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),intent(in)  :: bV
+      integer,       intent(in)  :: lsize
+
+! !OUTPUT PARAMETERS: 
+!
+      type(AttrVect),intent(out) :: aV
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 17May01 - R. Jacob <jacob@mcs.anl.gov> - add a check to see if
+!           input argument has been defined.  SGI will dump
+!           core if its not.
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - Nullify all pointers
+!           in ouput AttrVect aV before initializing aV.
+! 19Sep08 - J. Wolfe <jwolfe@ucar.edu> - plug memory leak from not deallocating
+!           strings.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initv_'
+  type(String) :: iLStr,rLStr
+
+	! Step One:  Nullify all pointers in aV.  We will set
+        ! only the pointers we really need for aV based on those
+        ! currently ASSOCIATED in bV.
+
+  call List_nullify(aV%iList)
+  call List_nullify(aV%rList)
+  nullify(aV%iAttr)
+  nullify(aV%rAttr)
+
+	! Convert the two Lists to two Strings
+
+  if(.not.associated(bv%iList%bf) .and. & 
+       .not.associated(bv%rList%bf)) then
+     write(stderr,'(2a)')myname_, &
+      'MCTERROR:  Trying to initialize a new AttrVect off an undefined AttrVect'
+      call die(myname_,'undefined input argument',0)
+  endif
+
+  if(associated(bv%iList%bf)) then
+     call get(iLStr,bv%iList)
+  endif
+
+  if(associated(bv%rList%bf)) then
+     call get(rLStr,bv%rList)
+  endif
+
+       ! Initialize the AttrVect aV depending on which parts of
+       ! the input bV are valid:
+
+  if(associated(bv%iList%bf) .and. associated(bv%rList%bf)) then
+     call init_(aV,iList=char(iLStr),rList=char(rLStr),lsize=lsize)
+  endif
+  if(.not.associated(bv%iList%bf) .and. associated(bv%rList%bf)) then
+     call init_(aV,rList=char(rLStr),lsize=lsize)
+  endif
+  if(associated(bv%iList%bf) .and. .not.associated(bv%rList%bf)) then
+     call init_(aV,iList=char(iLStr),lsize=lsize)
+  endif
+
+  if(associated(bv%iList%bf)) then  
+     call String_clean(iLStr)       
+  endif                             
+  if(associated(bv%rList%bf)) then  
+     call String_clean(rLStr)       
+  endif                             
+
+ end subroutine initv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initl_ - Initialize an AttrVect Using the List Type
+!
+! !DESCRIPTION:  This routine initializes an {\tt AttrVect} directly 
+! from input {\tt List} data type arguments {\tt iList} and {\tt rList} 
+! (see the module {\tt m\_List} in mpeu for further details), and an
+! input length {\tt lsize}.  The resulting {\tt AttrVect} is returned in
+! the argument {\tt aV}.
+!
+! {\bf N.B.}:  If the user supplies an empty list for the arguments 
+! {\tt iList} ({\tt rList}), then {\tt aV} will be created only with 
+! {\tt REAL} ({\tt INTEGER}) attributes.  If both arguments {\tt iList} 
+! and {\tt rList} are empty, the routine will terminate execution and 
+! report an error.
+!
+! {\bf N.B.}:  The outcome of this routine, {\tt aV} represents 
+! allocated memory.  When this {\tt AttrVect} is no longer needed, 
+! it must be deallocated by invoking the routine {\tt AttrVect\_clean()}.  
+! Failure to do so will spawn a memory leak.
+!
+! !INTERFACE:
+
+ subroutine initl_(aV, iList, rList, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+      use m_String, only : String_toChar => toChar
+
+      use m_List, only : List
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_exportToChar => exportToChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),  intent(in)  :: iList
+      type(List),  intent(in)  :: rList
+      integer,     intent(in)  :: lsize
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect), intent(out) :: aV
+
+! !REVISION HISTORY:
+! 09May98 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! 08Aug01 - E.T. Ong <eong@mcs.anl.gov> - change list assignment(=)
+!           to list copy to avoid compiler errors with pgf90.
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - Nullify all pointers
+!           in ouput AttrVect aV before initializing aV.  Also, 
+!           greater caution taken regarding validity of input 
+!           arguments iList and rList.
+! 15May08 - J. Larson <larson@mcs.anl.gov> - Simplify to use
+!           the init_ routine.  Better argument checking.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initl_'
+
+  ! Basic argument sanity checks:
+
+  if (List_nitem(iList) < 0) then
+     write(stderr,'(2a,i8,a)') myname_, &
+          ':: FATAL:  List argument iList has a negative number ( ',List_nitem(iList), &
+          ' ) of attributes!'
+     call die(myname_)
+  endif
+
+  if (List_nitem(rList) < 0) then
+     write(stderr,'(2a,i8,a)') myname_, &
+          ':: FATAL:  List argument rList has a negative number ( ',List_nitem(rList), &
+          ' ) of attributes!'
+     call die(myname_)
+  endif
+
+  if ((List_nitem(iList) > 0) .and. (List_nitem(rList) > 0)) then
+
+     call init_(aV, List_exportToChar(iList), List_exportToChar(rList), lsize)
+
+  else ! Then solely REAL or solely INTEGER attributes:
+
+     if (List_nitem(iList) > 0) then ! solely INTEGER attributes
+                
+        call init_(aV, iList=List_exportToChar(iList), lsize=lsize)
+
+     endif ! if (List_nitem(iList) > 0) then...
+
+     if (List_nitem(rList) > 0) then ! solely REAL attributes
+                
+        call init_(aV, rList=List_exportToChar(rList), lsize=lsize)
+
+     endif ! if (List_nitem(rList) > 0) then...
+
+  endif ! if ((List_nitem(iList) > 0) .and. (List_nitem(rList) > 0)) then...
+
+ end subroutine initl_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Deallocate Allocated Memory Structures of an AttrVect
+!
+! !DESCRIPTION:
+! This routine deallocates the allocated memory structures of the 
+! input/output {\tt AttrVect} argument {\tt aV}.  This amounts to 
+! cleaning the {\tt List} structures {\tt aV\%iList} and {\tt av\%rList},
+! and deallocating the arrays {\tt aV\%iAttr(:,:)} and 
+! {\tt aV\%rAttr(:,:)}.  The success (failure) of this operation is 
+! signified by a zero (non-zero) value of the optional {\tt INTEGER} 
+! output argument {\tt stat}.  If {\tt clean\_()} is invoked without
+! supplying {\tt stat}, and any of the deallocation operations fail,
+! the routine will terminate with an error message.
+!
+! !INTERFACE:
+
+ subroutine clean_(aV, stat)
+!
+! !USES:
+!
+      use m_mall
+      use m_stdio
+      use m_die
+      use m_List, only : List_clean => clean
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),    intent(inout) :: aV
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 09Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - various fixes to 
+!           prevent deallocation of UNASSOCIATED pointers.
+! 01Mar01 - E.T. Ong <eong@mcs.anl.gov> - removed dies to prevent
+!           crashes when cleaning uninitialized attrvects. Added
+!           optional stat argument.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+	! Note that an undefined pointer may either crash the process
+	! or return either .true. or .false. to the associated() test.
+	! One should therefore avoid using the function on an 
+	! undefined pointer.
+
+        ! Clean up INTEGER attribute list:
+
+  if(present(stat)) stat=0
+  
+  if(associated(aV%iList%bf)) then
+
+     if(present(stat)) then
+	call List_clean(aV%iList,ier)
+	if(ier/=0) stat=ier
+     else
+	call List_clean(aV%iList)
+     endif
+
+  endif
+
+        ! Clean up REAL attribute list:
+
+  if(associated(aV%rList%bf)) then
+
+     if(present(stat)) then
+	call List_clean(aV%rList,ier)
+	if(ier/=0) stat=ier
+     else
+	call List_clean(aV%rList)
+     endif
+
+  endif
+
+        ! Clean up INTEGER attributes:
+
+  if(associated(aV%iAttr)) then
+
+#ifdef MALL_ON
+     call mall_co(size(transfer(aV%iAttr,(/1/)),myname_)
+#endif
+
+     deallocate(aV%iAttr,stat=ier)
+
+     if(ier /= 0) then
+	if(present(stat)) then
+	   stat=ier
+	else
+	   call warn(myname_,'deallocate(aV%iAttr)',ier)
+	endif
+     endif
+
+  endif ! if(associated(aV%iAttr))...
+  
+        ! Clean up REAL attributes:
+
+  if(associated(aV%rAttr)) then
+
+#ifdef MALL_ON
+     call mall_co(size(transfer(aV%rAttr,(/1/)),myname_)
+#endif
+
+     deallocate(aV%rAttr,stat=ier)
+
+     if(ier /= 0) then
+	if(present(stat)) then
+	   stat=ier
+	else
+	   call warn(myname_,'deallocate(aV%rAttr)',ier)
+	endif
+     endif
+
+  endif ! if(associated(aV%rAttr))...
+
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize_ - Length of an AttrVect
+!
+! !DESCRIPTION:
+! This function returns the number of elements, or {\em length} of the 
+! input {\tt AttrVect} argument {\tt aV}.  This function examines the 
+! length of the second dimension of the arrays {\tt aV\%iAttr(:,:)} 
+! and {\tt aV\%rAttr(:,:)}.  If neither {\tt aV\%iAttr(:,:)} nor
+! {\tt aV\%rAttr(:,:)} are associated, then ${\tt lsize\_(aV)} = 0$.
+! If {\tt aV\%iAttr(:,:)} is associated, but {\tt aV\%rAttr(:,:)} is 
+! not, then ${\tt lsize\_(aV)} = {\tt size(aV\%iAttr,2)}$. If 
+! {\tt aV\%iAttr(:,:)} is not associated, but {\tt aV\%rAttr(:,:)} is, 
+! then ${\tt lsize\_(aV)} = {\tt size(aV\%rAttr,2)}$. If both 
+! {\tt aV\%iAttr(:,:)} and {\tt aV\%rAttr(:,:)} are associated, the
+! function {\tt lsize\_()} will do one of two things:  If 
+! ${\tt size(aV\%iAttr,2)} = {\tt size(aV\%rAttr,2)}$, this equal value 
+! will be returned.  If ${\tt size(aV\%iAttr,2)} \neq 
+! {\tt size(aV\%rAttr,2)}$, termination with an error message will occur.
+!
+! !INTERFACE:
+
+ integer function lsize_(aV)
+
+! !USES:
+
+     use m_List,  only : List
+     use m_List,  only : List_allocated => allocated
+
+     use m_stdio, only : stderr
+     use m_die
+ 
+     implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect), intent(in) :: aV
+
+! !REVISION HISTORY:
+! 09Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - made code more robust
+!           to handle cases where the length of either aV%iAttr or
+!           aV%rAttr is zero, but the other is positive.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::lsize_'
+  integer :: iLength, rLength
+
+	! One should try to avoid using this function on an undefined
+	! or disassocated pointer.  However, it is understandable 
+	! that an undefined or disassocated pointer has a size 0, if
+	! the associated() test sucesses.
+
+  lsize_=0
+
+  if(List_allocated(aV%iList) .and. associated(aV%iAttr)) then
+     iLength = size(aV%iAttr,2)
+  else
+     iLength = 0
+  endif
+
+  if(List_allocated(aV%rList) .and. associated(aV%rAttr)) then
+     rLength = size(aV%rAttr,2)
+  else
+     rLength = 0
+  endif
+
+  if(iLength /= rLength) then
+
+     if((rLength > 0) .and. (iLength > 0)) then
+	call die(myname_,'attribute array length mismatch', &
+	     iLength-rLength)
+     endif
+
+     if((rLength > 0) .and. (iLength == 0)) then
+	lsize_ = rLength
+     endif
+
+     if((iLength > 0) .and. (rLength == 0)) then
+	lsize_ = iLength
+     endif
+
+  endif
+
+  if(iLength == rLength) lsize_ = iLength
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!        Math and Computer Science Division, Argonne National Laboratory
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: zero_ - Set AttrVect Field Data to Zero
+!
+! !DESCRIPTION:
+! This routine sets all of the point values of the integer and real 
+! attributes of an the input/output {\tt AttrVect} argument {\tt aV}
+! to zero.  The default action is to set the values of all the real and 
+! integer attributes to zero.  The user may prevent the zeroing of the 
+! real (integer) attributes invoking {\tt zero\_()} with the optional 
+! {\tt LOGICAL} argument {\tt zeroReals} ({\tt zeroInts}) set with value 
+! {\tt .FALSE.}
+!
+! !INTERFACE:
+
+ subroutine zero_(aV, zeroReals, zeroInts)
+
+! !USES:
+
+
+     use m_die,only	: die
+     use m_stdio,only	: stderr
+
+     use m_List, only : List
+     use m_List, only : List_allocated => allocated
+ 
+     implicit none
+
+! !INPUT PARAMETERS: 
+
+     logical, optional, intent(IN)    :: zeroReals
+     logical, optional, intent(IN)    :: zeroInts
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+     type(AttrVect),    intent(INOUT) :: aV
+
+! !REVISION HISTORY:
+! 17May01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype/code
+! 15Oct01 - J. Larson <larson@mcs.anl.gov> - switched loop order
+!           for cache optimization.
+! 03Dec01 - E.T. Ong <eong@mcs.anl.gov> - eliminated looping method of
+!           of zeroing. "Compiler assignment" of attrvect performs faster
+!           on the IBM SP with mpxlf90 compiler.
+! 05Jan10 - R. Jacob <jacob@mcs.anl.gov> - zeroing an uninitialized aV is no
+!           longer a fatal error.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::zero_'
+
+  logical myZeroReals, myZeroInts
+
+  if(present(zeroReals)) then
+     myZeroReals = zeroReals
+  else
+     myZeroReals = .TRUE.
+  endif
+
+  if(present(zeroInts)) then
+     myZeroInts = zeroInts
+  else
+     myZeroInts = .TRUE.
+  endif
+
+!  if((.not. List_allocated(aV%iList)) .and. (.not. List_allocated(aV%rList))) then
+!    write(stderr,'(2a)')myname_, &
+!      'MCTERROR:  Trying to zero an uninitialized AttrVect'
+!      call die(myname_)
+!  endif
+
+  if(myZeroInts) then ! zero out INTEGER attributes
+     if(List_allocated(aV%iList)) then
+!CDIR COLLAPSE
+        if(associated(aV%iAttr) .and. (nIAttr_(aV)>0)) aV%iAttr=0
+     endif
+  endif
+
+  if(myZeroReals) then ! zero out REAL attributes
+     if(List_allocated(aV%rList)) then
+!CDIR COLLAPSE
+        if(associated(aV%rAttr) .and. (nRAttr_(aV)>0)) aV%rAttr=0._FP
+     endif
+  endif
+
+ end subroutine zero_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nIAttr_ - Return the Number of Integer Attributes
+!
+! !DESCRIPTION:
+! This integer function returns the number of integer attributes 
+! present in the input {\tt AttrVect} argument {\tt aV}.
+!
+! !INTERFACE:
+
+ integer function nIAttr_(aV)
+!
+! !USES:
+!
+      use m_List, only : nitem
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),intent(in) :: aV
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - made code more robust
+!           by checking status of pointers in aV%iList
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nIAttr_'
+
+  if(associated(aV%iList%bf)) then
+     nIAttr_ = nitem(aV%iList)
+  else
+     nIAttr_ = 0
+  endif
+
+ end function nIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nRAttr_ - Return the Number of Real Attributes
+!
+! !DESCRIPTION:
+! This integer function returns the number of real attributes 
+! present in the input {\tt AttrVect} argument {\tt aV}.
+
+! !INTERFACE:
+
+ integer function nRAttr_(aV)
+!
+! !USES:
+!
+      use m_List, only : nitem
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),intent(in) :: aV
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - made code more robust
+!           by checking status of pointers in aV%iList
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nRAttr_'
+
+  if(associated(aV%rList%bf)) then
+     nRAttr_ = nitem(aV%rList)
+  else
+     nRAttr_ = 0
+  endif
+
+ end function nRAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getIList_ - Retrieve the Name of a Numbered Integer Attribute
+!
+! !DESCRIPTION:
+! This routine returns the name of the {\tt ith} integer attribute of 
+! the input {\tt AttrVect} argument {\tt aVect}.  The name is returned 
+! in the output {\tt String} argument {\tt item} (see the mpeu module 
+! {\tt m\_String} for more information regarding the {\tt String} type).
+!
+! !INTERFACE:
+
+ subroutine getIList_(item, ith, aVect)
+!
+! !USES:
+!
+      use m_String, only : String
+      use m_List,   only : get
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,     intent(in)  :: ith
+      type(AttrVect),intent(in) :: aVect
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),intent(out) :: item
+
+! !REVISION HISTORY:
+! 24Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getIList_'
+
+  call get(item, ith, aVect%iList)
+
+ end subroutine getIList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getRList_ - Retrieve the Name of a Numbered Real Attribute
+!
+! !DESCRIPTION:
+! This routine returns the name of the {\tt ith} real attribute of 
+! the input {\tt AttrVect} argument {\tt aVect}.  The name is returned 
+! in the output {\tt String} argument {\tt item} (see the mpeu module 
+! {\tt m\_String} for more information regarding the {\tt String} type).
+!
+! !INTERFACE:
+
+ subroutine getRList_(item, ith, aVect)
+!
+! !USES:
+!
+      use m_String, only : String
+      use m_List,   only : get
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,        intent(in)  :: ith
+      type(AttrVect), intent(in)  :: aVect
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),   intent(out) :: item
+
+! !REVISION HISTORY:
+! 24Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getRList_'
+
+  call get(item,ith,aVect%rList)
+
+ end subroutine getRList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexIA_ - Index an Integer Attribute
+!
+! !DESCRIPTION:
+! This function returns an {\tt INTEGER}, corresponding to the location 
+! of an integer attribute within the input {\tt AttrVect} argument 
+! {\tt aV}.  For example, suppose {\tt aV} has the following attributes
+! {\tt 'month'}, {\tt 'day'}, and {\tt 'year'}.  The array of integer 
+! values for the attribute {\tt 'day'}  is stored in 
+!% \begin{verbatim}
+! {\tt aV\%iAttr(indexIA\_(aV,'day'),:)}.
+!% \end{verbatim}
+! If {\tt indexIA\_()} is unable to match {\tt item} to any of the integer
+! attributes in {\tt aV}, the resulting value is zero which is equivalent
+! to an error.  The optional input {\tt CHARACTER} arguments {\tt perrWith} 
+! and {\tt dieWith} control how such errors are handled.  
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexIA\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, and
+! {\tt perrWith} is equal to ``quiet'', no error message is written.
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ integer function indexIA_(aV, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_die,  only : die
+      use m_stdio,only : stderr
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_List, only : index
+
+      use m_TraceBack, only : GenTraceBackString
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),             intent(in) :: aV
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!  2Aug02 - J. Larson - Solidified error handling using perrWith/dieWith
+!  1Jan05 - R. Jacob - add quiet option for error handling
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexIA_'
+
+  type(String) :: myTrace
+
+  if(present(dieWith)) then
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then
+	call GenTraceBackString(myTrace, perrWith, myname_)
+     else
+	call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+  indexIA_=index(aV%iList,item)
+
+  if(indexIA_==0) then ! The attribute was not found!
+       ! As per the prologue, decide how to handle this error
+     if(present(perrWith) .and. (.not. present(dieWith))) then
+       if (trim(perrWith).eq.'quiet') then
+        ! do nothing
+       else
+        write(stderr,'(5a)') myname_, &
+             ':: ERROR--attribute not found: "',trim(item),'" ', &
+             'Traceback:  ',String_ToChar(myTrace)
+       endif
+     else ! Shutdown
+	write(stderr,'(5a)') myname_, &
+	     ':: FATAL--attribute not found: "',trim(item),'" ', &
+	     'Traceback:  ',String_ToChar(myTrace)
+	call die(myname_)
+     endif
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexIA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math and Computer Science Division, Argonne National Laboratory  !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexRA_ - Index a Real Attribute
+!
+! !DESCRIPTION:
+! This function returns an {\tt INTEGER}, corresponding to the location 
+! of a real attribute within the input {\tt AttrVect} argument 
+! {\tt aV}.  For example, suppose {\tt aV} has the following attributes
+! {\tt 'latitude'}, {\tt 'longitude'}, and {\tt 'pressure'}.  The array 
+! of real values for the attribute {\tt 'longitude'}  is stored in 
+!% \begin{verbatim}
+! {\tt aV\%iAttr(indexRA\_(aV,'longitude'),:)}.
+!% \end{verbatim}
+! If {\tt indexRA\_()} is unable to match {\tt item} to any of the real
+! attributes in {\tt aV}, the resulting value is zero which is equivalent
+! to an error.  The optional input {\tt CHARACTER} arguments {\tt perrWith} 
+! and {\tt dieWith} control how such errors are handled.  
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexRA\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, and
+! {\tt perrWith} is equal to ``quiet'', no error message is written.
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ integer function indexRA_(aV, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_die,  only : die
+      use m_stdio,only : stderr
+
+      use m_List, only : index
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),             intent(in) :: aV
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!  2Aug02 - J. Larson - Solidified error handling using perrWith/dieWith
+! 18Jan05 - R. Jacob - add quiet option for error handling
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexRA_'
+
+  type(String) :: myTrace
+
+  if(present(dieWith)) then ! Append onto TraceBack
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! Append onto TraceBack
+	call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBackString
+	call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+  indexRA_=index(aV%rList,item)
+
+  if(indexRA_==0) then ! The attribute was not found!
+       ! As per the prologue, decide how to handle this error
+     if(present(perrWith) .and. (.not. present(dieWith))) then
+       if (trim(perrWith).eq.'quiet') then
+        ! do nothing
+       else
+	write(stderr,'(5a)') myname_, &
+	     ':: ERROR--attribute not found: "',trim(item),'" ', &
+	     'Traceback:  ',String_ToChar(myTrace)
+       endif
+     else ! Shutdown if dieWith or no arguments present
+	write(stderr,'(5a)') myname_, &
+	     ':: FATAL--attribute not found: "',trim(item),'" ', &
+	     'Traceback:  ',String_ToChar(myTrace)
+	call die(myname_)
+     endif
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexRA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       DOE/ANL Mathematics and Computer Science Division              !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: appendIAttr_ - Append one or more attributes onto the INTEGER part of an AttrVect.
+!
+! !DESCRIPTION:  This routine takes an input {\tt AttrVect} argument 
+! {\tt aV}, and an input character string {\tt rList} and Appends {\tt rList}
+! to the INTEGER part of {\tt aV}. The success (failure) of this operation is
+! signified by a zero (nonzero) value for the optional {\tt INTEGER} 
+! output argument {\tt status}.  
+!
+! !INTERFACE:
+
+ subroutine appendIAttr_(aV, iList, status)
+!
+! !USES:
+!
+      use m_List,   only : List_init => init
+      use m_List,   only : List_append => append
+      use m_List,   only : List_clean => clean
+      use m_List,   only : List_nullify => nullify
+      use m_List,   only : List_allocated => allocated
+      use m_List,   only : List_copy => copy
+      use m_List,   only : List
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),intent(inout)  :: aV
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*), intent(in)  :: iList
+
+! !OUTPUT PARAMETERS: 
+!
+      integer,optional,intent(out)  :: status
+
+! !REVISION HISTORY:
+! 08Jul03 - R. Jacob <jacob@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::appendIAttr_'
+
+  type(List) :: avRList,avIList        ! placeholders for the aV attributes
+  type(List) :: addIlist               ! for the input string
+  type(AttrVect) :: tempaV             ! placeholder for aV data.
+  integer :: locsize                   ! size of aV
+  integer :: rlstatus,cstatus           ! status flags
+  integer :: ilstatus
+
+  if(present(status)) status = 0
+
+  call List_nullify(avIList)
+  call List_nullify(avRList)
+
+! save the local size and current int and real attributes
+  locsize = lsize_(aV)
+  call exportRList_(aV,avRList,rlstatus)
+  call exportIList_(aV,avIList,ilstatus)
+
+! create and fill a temporary AttrVect to hold any data currently in the aV
+  call initv_(tempaV,aV,lsize=locsize)
+  call Copy_(aV,tempaV)
+
+! create a List with the new attributes
+  call List_init(addIlist,iList)
+
+! append addIlist to current avIList if it has attributes.
+  if(List_allocated(avIList)) then
+    call List_append(avIList,addIlist)
+! copy addIlist to avIList
+  else
+    call List_copy(avIList,addIlist)
+  endif
+
+! now delete the input aV and recreate it
+  call clean_(aV,cstatus)
+  call initl_(aV,avIList,avRList,locsize)
+
+! copy back the data
+  call Copy_(tempaV,aV)
+
+! clean up.
+  call List_clean(avRList,cstatus)
+
+  call clean_(tempaV,cstatus)
+  call List_clean(addIlist,cstatus)
+  call List_clean(avIList,cstatus)
+
+  if(present(status)) status = cstatus
+
+ end subroutine appendIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       DOE/ANL Mathematics and Computer Science Division              !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: appendRAttr_ - Append one or more attributes onto the REAL part of an AttrVect.
+!
+! !DESCRIPTION:  This routine takes an input {\tt AttrVect} argument 
+! {\tt aV}, and an input character string {\tt rList} and Appends {\tt rList}
+! to the REAL part of {\tt aV}. The success (failure) of this operation is
+! signified by a zero (nonzero) value for the optional {\tt INTEGER} 
+! output argument {\tt status}.  
+!
+! !INTERFACE:
+
+ subroutine appendRAttr_(aV, rList, status)
+!
+! !USES:
+!
+      use m_List,   only : List_init => init
+      use m_List,   only : List_append => append
+      use m_List,   only : List_clean => clean
+      use m_List,   only : List_nullify => nullify
+      use m_List,   only : List_allocated => allocated
+      use m_List,   only : List_copy => copy
+      use m_List,   only : List
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),intent(inout)  :: aV
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*), intent(in)  :: rList
+
+! !OUTPUT PARAMETERS: 
+!
+      integer,optional,intent(out)  :: status
+
+! !REVISION HISTORY:
+! 04Jun03 - R. Jacob <jacob@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::appendRAttr_'
+
+  type(List) :: avRList,avIList        ! placeholders for the aV attributes
+  type(List) :: addRlist               ! for the input string
+  type(AttrVect) :: tempaV             ! placeholder for aV data.
+  integer :: locsize                   ! size of aV
+  integer :: rlstatus,cstatus           ! status flags
+  integer :: ilstatus
+
+  if(present(status)) status = 0
+
+  call List_nullify(avIList)
+  call List_nullify(avRList)
+
+! save the local size and current int and real attributes
+  locsize = lsize_(aV)
+  call exportRList_(aV,avRList,rlstatus)
+  call exportIList_(aV,avIList,ilstatus)
+
+! create and fill a temporary AttrVect to hold any data currently in the aV
+  call initv_(tempaV,aV,lsize=locsize)
+  call Copy_(aV,tempaV)
+
+! create a List with the new attributes
+  call List_init(addRlist,rList)
+
+! append addRlist to current avRList if it has attributes.
+  if(List_allocated(avRList)) then
+    call List_append(avRList,addRlist)
+! copy addRlist to avRList
+  else
+    call List_copy(avRList,addRlist)
+  endif
+
+! now delete the input aV and recreate it
+  call clean_(aV,cstatus)
+  call initl_(aV,avIList,avRList,locsize)
+
+! copy back the data
+  call Copy_(tempaV,aV)
+
+! clean up.
+  call List_clean(avIList,cstatus)
+
+  call clean_(tempaV,cstatus)
+  call List_clean(addRlist,cstatus)
+  call List_clean(avRList,cstatus)
+
+  if(present(status)) status = cstatus
+
+ end subroutine appendRAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportIList_ - Return INTEGER Attribute List
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the integer attribute list, and returns it as the {\tt List} output 
+! argument {\tt outIList}.  The success (failure) of this operation is
+! signified by a zero (nonzero) value for the optional {\tt INTEGER} 
+! output argument {\tt status}.  
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt List} data 
+! structure ({\tt outIList}).  The user is responsible for deallocating 
+! this structure by invoking {\tt List\_clean()} (see the module 
+! {\tt m\_List} for details) once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportIList_(aV, outIList, status)
+
+!
+! !USES:
+!
+      use m_die ,  only : die
+      use m_stdio, only : stderr
+
+      use m_List,  only : List
+      use m_List,  only : List_allocated => allocated
+      use m_List,  only : List_copy => copy
+      use m_List,  only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)  :: aV
+
+! !OUTPUT PARAMETERS: 
+
+      type(List),                 intent(out) :: outIList
+      integer,          optional, intent(out) :: status
+
+! !REVISION HISTORY:
+! 14Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportIList_'
+
+       ! Initialize status flag (if present) to success value of zero.
+
+  if(present(status)) status = 0
+
+  if(List_allocated(aV%iList)) then
+     call List_copy(outIList, aV%iList)
+  else
+     call List_nullify(outIList)
+     if(present(status)) then
+	status = 1
+     else
+	call die(myname_)
+     endif
+  endif
+
+ end subroutine exportIList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportRList_ - Return REAL attribute List
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the real attribute list, and returns it as the {\tt List} output 
+! argument {\tt outRList}.  The success (failure) of this operation is
+! signified by a zero (nonzero) value for the optional {\tt INTEGER} 
+! output argument {\tt status}.
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt List} data 
+! structure ({\tt outRList}).  The user is responsible for deallocating 
+! this structure by invoking {\tt List\_clean()} (see the module 
+! {\tt m\_List} for details) once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportRList_(aV, outRList, status)
+
+!
+! !USES:
+!
+      use m_die ,  only : die
+      use m_stdio, only : stderr
+
+      use m_List,  only : List
+      use m_List,  only : List_allocated => allocated
+      use m_List,  only : List_copy => copy
+      use m_List,  only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),           intent(in)  :: aV
+
+! !OUTPUT PARAMETERS: 
+
+      type(List),               intent(out) :: outRList
+      integer,        optional, intent(out) :: status
+
+! !REVISION HISTORY:
+! 14Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRList_'
+
+       ! Initialize status flag (if present) to success value of zero.
+
+  if(present(status)) status = 0
+
+  if(List_allocated(aV%rList)) then
+     call List_copy(outRList, aV%rList)
+  else
+     call List_nullify(outRList)
+     if(present(status)) then
+	status = 1
+     else
+	call die(myname_)
+     endif
+  endif
+
+ end subroutine exportRList_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportIListToChar_ - Return AttrVect\%iList as CHARACTER
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the integer attribute list (see the mpeu module {\tt m\_List} for more 
+! information regarding the {\tt List} type), and returns it as a 
+! {\tt CHARACTER} suitable for printing.  An example of its usage is
+! \begin{verbatim}
+!           write(stdout,'(1a)') exportIListToChar_(aV) 
+! \end{verbatim}
+! which writes the contents of {\tt aV\%iList\%bf} to the Fortran device 
+! {\tt stdout}.
+!
+! !INTERFACE:
+
+ function exportIListToChar_(aV)
+
+!
+! !USES:
+!
+      use m_die ,  only : die
+      use m_stdio, only : stderr
+
+      use m_List,  only : List
+      use m_List,  only : List_allocated => allocated
+      use m_List,  only : List_copy => copy
+      use m_List,  only : List_exportToChar => exportToChar
+      use m_List,  only : List_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),       intent(in) :: aV
+
+! !OUTPUT PARAMETERS: 
+
+      character(len=size(aV%iList%bf,1)) :: exportIListToChar_
+
+! !REVISION HISTORY:
+! 13Feb02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! 05Jun03 - R. Jacob <jacob@mcs.anl.gov> - return a blank instead of dying
+!           to avoid I/O errors when this function is used in a write statement.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportIListToChar_'
+
+  ! The following extraneous list copy avoids a bug in the 
+  ! SGI MIPSpro Fortran 90 compiler version 7.30. and the
+  ! Sun Fortran 90 Workshop compiler 5.0. If this line is removed, 
+  ! the following error will occur during compile time:
+
+  ! Signal: Segmentation fault in IR->WHIRL Conversion phase.
+  ! "m_AttrVect.F90": Error: Signal Segmentation fault in phase IR->WHIRL 
+  ! Conversion -- processing aborted
+  ! f90 ERROR:  /opt/MIPSpro/73/usr/lib32/cmplrs/mfef90 died due to signal 4
+  ! f90 ERROR:  core dumped
+  ! *** Error code 32 (bu21)
+
+  type(List) :: iListCopy
+
+       ! Extract the INTEGER attribute list to a character:
+
+  if(List_allocated(aV%iList)) then
+     call List_copy(iListCopy,aV%iList)
+     exportIListToChar_ = List_exportToChar(iListCopy)
+     call List_clean(iListCopy)
+  else
+     exportIListToChar_ = ''
+  endif
+
+ end function exportIListToChar_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportRListToChar_ - Return AttrVect\%rList as CHARACTER
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the real attribute list (see the mpeu module {\tt m\_List} for more 
+! information regarding the {\tt List} type), and returns it as a 
+! {\tt CHARACTER} suitable for printing.  An example of its usage is
+! \begin{verbatim}
+!           write(stdout,'(1a)') exportRListToChar_(aV) 
+! \end{verbatim}
+! which writes the contents of {\tt aV\%rList\%bf} to the Fortran device 
+! {\tt stdout}.
+!
+! !INTERFACE:
+
+ function exportRListToChar_(aV)
+
+!
+! !USES:
+!
+      use m_die ,  only : die
+      use m_stdio, only : stderr
+
+      use m_List,  only : List
+      use m_List,  only : List_allocated => allocated
+      use m_List,  only : List_copy => copy
+      use m_List,  only : List_exportToChar => exportToChar
+      use m_List,  only : List_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),       intent(in) :: aV
+
+! !OUTPUT PARAMETERS: 
+
+      character(len=size(aV%rList%bf,1)) :: exportRListToChar_
+
+! !REVISION HISTORY:
+! 13Feb02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! 05Jun03 - R. Jacob <jacob@mcs.anl.gov> - return a blank instead of dying
+!           to avoid I/O errors when this function is used in a write statement.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRListToChar_'
+
+  ! The following extraneous list copy avoids a bug in the 
+  ! SGI MIPSpro Fortran 90 compiler version 7.30. and the
+  ! Sun Fortran 90 Workshop compiler 5.0. If this line is removed, 
+  ! the following error will occur during compile time:
+
+  ! Signal: Segmentation fault in IR->WHIRL Conversion phase.
+  ! "m_AttrVect.F90": Error: Signal Segmentation fault in phase IR->WHIRL 
+  ! Conversion -- processing aborted
+  ! f90 ERROR:  /opt/MIPSpro/73/usr/lib32/cmplrs/mfef90 died due to signal 4
+  ! f90 ERROR:  core dumped
+  ! *** Error code 32 (bu21)
+
+  type(List) :: rListCopy
+
+       ! Extract the REAL attribute list to a character:
+
+  if(List_allocated(aV%rList)) then
+     call List_copy(rListCopy,aV%rList)
+     exportRListToChar_ = List_exportToChar(rListCopy)
+     call List_clean(rListCopy)
+  else
+     exportRListToChar_ = ''
+  endif
+
+ end function exportRListToChar_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportIAttr_ - Return INTEGER Attribute as a Vector
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the integer attribute corresponding to the tag defined in the input 
+! {\tt CHARACTER} argument {\tt AttrTag}, and returns it in the 
+! {\tt INTEGER} output array {\tt outVect}, and its length in the output
+! {\tt INTEGER} argument {\tt lsize}.  The optional input {\tt CHARACTER} 
+! arguments {\tt perrWith} and {\tt dieWith} control how errors are 
+! handled.  
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt exportIAttr\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt AttrVect} {\tt List} component {\tt aV\%iList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) before this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportIAttr_(aV, AttrTag, outVect, lsize, perrWith, dieWith)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in) :: aV
+      character(len=*),           intent(in) :: AttrTag
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !OUTPUT PARAMETERS: 
+
+      integer,      dimension(:), pointer     :: outVect
+      integer,          optional, intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - added capability 
+!           to work with pre-allocated outVect.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportIAttr_'
+
+  integer :: index, ierr, n, myLsize
+  type(String) :: myTrace
+
+  if(present(dieWith)) then ! Append onto TraceBack
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! Append onto TraceBack
+	call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBackString
+	call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Index the attribute we wish to extract:
+
+  index = indexIA_(aV, attrTag, dieWith=String_ToChar(myTrace))
+
+       ! Determine the number of data points:
+
+  myLsize = lsize_(aV)
+
+       ! Allocate space for outVect (if it is not already dimensioned)
+
+  if(associated(outVect)) then ! check the size of outVect
+     if(size(outVect) < myLsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	    ':: ERROR length of output array outVect ', &
+	    ' less than length of aV.  size(outVect)=',size(outVect), &
+	    ', length of aV=',myLsize
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)
+	call die(myname_)
+     endif
+  else ! allocate space for outVect
+     allocate(outVect(myLsize), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: Error - allocate(outVect(...) failed. ierr = ',ierr
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)	
+	call die(myname_)
+     endif
+  endif
+
+       ! Copy the attribute data into outVect
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,myLsize
+     outVect(n) = aV%iAttr(index,n)
+  end do
+
+  ! return optional output argument lsize:
+  if(present(lsize)) lsize = myLsize
+
+  call String_clean(myTrace)
+
+ end subroutine exportIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrSP_ - Return REAL Attribute as a Pointer to Array
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt AttrVect} argument {\tt aV} 
+! the real attribute corresponding to the tag defined in the input 
+! {\tt CHARACTER} argument {\tt AttrTag}, and returns it in the 
+! {\tt REAL} output array {\tt outVect}, and its length in the output
+! {\tt INTEGER} argument {\tt lsize}.  The optional input {\tt CHARACTER} 
+! arguments {\tt perrWith} and {\tt dieWith} control how errors are 
+! handled.  
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt exportRAttr\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied traceback
+! information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied traceback
+! information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt AttrVect} {\tt List} component {\tt aV\%iList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) before this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportRAttrSP_(aV, AttrTag, outVect, lsize, perrWith, dieWith)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in) :: aV
+      character(len=*),           intent(in) :: AttrTag
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !OUTPUT PARAMETERS: 
+
+      real(SP),        dimension(:),  pointer     :: outVect
+      integer,          optional,     intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - added capability 
+!           to work with pre-allocated outVect.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrSP_'
+
+  integer :: index, ierr, n, myLsize
+  type(String) :: myTrace
+
+  if(present(dieWith)) then ! Append onto TraceBack
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! Append onto TraceBack
+	call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBackString
+	call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Index the attribute we wish to extract:
+
+  index = indexRA_(aV, attrTag, dieWith=String_ToChar(myTrace))
+
+       ! Determine the number of data points:
+
+  myLsize = lsize_(aV)
+
+       ! Allocate space for outVect (if it is not already dimensioned)
+
+  if(associated(outVect)) then ! check the size of outVect
+     if(size(outVect) < myLsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	    ':: ERROR length of output array outVect ', &
+	    ' less than length of aV.  size(outVect)=',size(outVect), &
+	    ', length of aV=',myLsize
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)
+	call die(myname_)
+     endif
+  else ! allocate space for outVect
+     allocate(outVect(myLsize), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: Error - allocate(outVect(...) failed. ierr = ',ierr
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)	
+	call die(myname_)
+     endif
+  endif
+
+       ! Copy the attribute data into outVect
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,myLsize
+     outVect(n) = aV%rAttr(index,n)
+  end do
+
+  call String_clean(myTrace)
+
+  ! return optional argument lsize
+  if(present(lsize)) lsize = myLsize
+
+ end subroutine exportRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrDP_ - Return REAL Attribute as a Pointer to Array
+!
+! !DESCRIPTION:
+! Double precision version of exportRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine exportRAttrDP_(aV, AttrTag, outVect, lsize, perrWith, dieWith)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in) :: aV
+      character(len=*),           intent(in) :: AttrTag
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !OUTPUT PARAMETERS: 
+
+      real(DP),    dimension(:),  pointer     :: outVect
+      integer,          optional, intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - added capability 
+!           to work with pre-allocated outVect.
+!
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrDP_'
+
+  integer :: index, ierr, n, myLsize
+  type(String) :: myTrace
+
+  if(present(dieWith)) then ! Append onto TraceBack
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! Append onto TraceBack
+	call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBackString
+	call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Index the attribute we wish to extract:
+
+  index = indexRA_(aV, attrTag, dieWith=String_ToChar(myTrace))
+
+       ! Determine the number of data points:
+
+  myLsize = lsize_(aV)
+
+       ! Allocate space for outVect (if it is not already dimensioned)
+
+  if(associated(outVect)) then ! check the size of outVect
+     if(size(outVect) < myLsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	    ':: ERROR length of output array outVect ', &
+	    ' less than length of aV.  size(outVect)=',size(outVect), &
+	    ', length of aV=',myLsize
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)
+	call die(myname_)
+     endif
+  else ! allocate space for outVect
+     allocate(outVect(myLsize), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: Error - allocate(outVect(...) failed. ierr = ',ierr
+	write(stderr,'(2a)') 'Traceback:  ',String_ToChar(myTrace)	
+	call die(myname_)
+     endif
+  endif
+
+       ! Copy the attribute data into outVect
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,myLsize
+     outVect(n) = aV%rAttr(index,n)
+  end do
+
+  call String_clean(myTrace)
+
+  ! return optional argument lsize
+  if(present(lsize)) lsize = myLsize
+
+ end subroutine exportRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importIAttr_ - Import INTEGER Vector as an Attribute
+!
+! !DESCRIPTION:
+! This routine imports into the input/output {\tt AttrVect} argument 
+! {\tt aV} the integer attribute corresponding to the tag defined in the 
+! input {\tt CHARACTER} argument {\tt AttrTag}.  The data to be imported
+! is provided in the {\tt INTEGER} input array {\tt inVect}, and the 
+! number of entries to be imported in the optional input {\tt INTEGER} 
+! argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt AttrVect} {\tt List} component {\tt aV\%iList}.
+!
+! !INTERFACE:
+
+ subroutine importIAttr_(aV, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),       intent(in)    :: AttrTag
+      integer,  dimension(:), pointer       :: inVect
+      integer,  optional,     intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(AttrVect),         intent(inout) :: aV
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importIAttr_'
+
+  integer :: index, aVsize, ierr, n, mysize
+
+       ! Index the attribute we wish to extract:
+
+  index = indexIA_(aV, attrTag)
+
+       ! Determine the number of data points:
+
+  aVsize = lsize_(aV)
+
+       ! Check input array size vs. lsize_(aV):
+
+  if(present(lsize)) then
+     if(aVsize < lsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ', number of entries to be imported=',lsize
+	call die(myname_)
+     endif
+     mysize=lsize
+  else
+     if(aVsize < size(inVect)) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ' , number of entries to be imported=',size(inVect)
+	call die(myname_)
+     endif
+     mysize = aVsize
+  endif
+
+       ! Copy the data from inVect to its attribute slot:
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,mysize
+     aV%iAttr(index,n) = inVect(n)
+  end do
+
+ end subroutine importIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrSP_ - Import REAL Vector as an Attribute
+!
+! !DESCRIPTION:
+! This routine imports into the input/output {\tt AttrVect} argument 
+! {\tt aV} the real attribute corresponding to the tag defined in the 
+! input {\tt CHARACTER} argument {\tt AttrTag}.  The data to be imported
+! is provided in the {\tt REAL} input array {\tt inVect}, and its 
+! length in the optional input {\tt INTEGER} argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt AttrVect} {\tt List} component {\tt aV\%rList}.
+!
+! !INTERFACE:
+
+ subroutine importRAttrSP_(aV, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),   intent(in)    :: AttrTag
+      real(SP), dimension(:), pointer   :: inVect
+      integer, optional,  intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(AttrVect),     intent(inout) :: aV
+
+
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrSP_'
+
+  integer :: index, aVsize, ierr, n, mysize
+
+       ! Index the attribute we wish to extract:
+
+  index = indexRA_(aV, attrTag)
+
+       ! Determine the number of data points:
+
+  aVsize = lsize_(aV)
+
+       ! Check input array size vs. lsize_(aV):
+
+  if(present(lsize)) then
+     if(aVsize < lsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ', number of entries to be imported=',lsize
+	call die(myname_)
+     endif
+     mysize=lsize
+  else
+     if(aVsize < size(inVect)) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ' , number of entries to be imported=',size(inVect)
+	call die(myname_)
+     endif
+     mysize=aVsize
+  endif
+
+       ! Copy the attribute data into outVect
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,mysize
+     aV%rAttr(index,n) = inVect(n)
+  end do
+
+ end subroutine importRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrDP_ - Import REAL Vector as an Attribute
+!
+! !DESCRIPTION:
+! Double precision version of importRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine importRAttrDP_(aV, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),   intent(in)    :: AttrTag
+      real(DP), dimension(:), pointer   :: inVect
+      integer, optional,  intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(AttrVect),     intent(inout) :: aV
+
+
+
+! !REVISION HISTORY:
+! 19Oct01 - J.W. Larson <larson@mcs.anl.gov> - initial (slow) 
+!           prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrDP_'
+
+  integer :: index, aVsize, ierr, n, mysize
+
+       ! Index the attribute we wish to extract:
+
+  index = indexRA_(aV, attrTag)
+
+       ! Determine the number of data points:
+
+  aVsize = lsize_(aV)
+
+       ! Check input array size vs. lsize_(aV):
+
+  if(present(lsize)) then
+     if(aVsize < lsize) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ', number of entries to be imported=',lsize
+	call die(myname_)
+     endif
+     mysize=lsize
+  else
+     if(aVsize < size(inVect)) then
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	               ':: ERROR--attempt to import too many entries ', &
+                       'into AttrVect aV.  AttrVect_lsize(aV)=',aVsize, &
+                       ' , number of entries to be imported=',size(inVect)
+	call die(myname_)
+     endif
+     mysize=aVsize
+  endif
+
+       ! Copy the attribute data into outVect
+
+!$OMP PARALLEL DO PRIVATE(n)
+  do n=1,mysize
+     aV%rAttr(index,n) = inVect(n)
+  end do
+
+ end subroutine importRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: RCopy_ - Copy Real Attributes from One AttrVect to Another
+!
+! !DESCRIPTION:
+! This routine copies from input argment {\tt aVin} into the output 
+! {\tt AttrVect} argument {\tt aVout} the shared real attributes.
+!
+! If the optional argument {\tt Vector} is present and true, the vector 
+! architecture-friendly portions of this routine will be invoked.
+!
+! If the optional argument {\tt sharedIndices} is present, it should be
+! the result of the call {\tt SharedIndicesOneType\_(aVin, aVout, 'REAL',
+! sharedIndices)}. Providing this argument speeds up this routine
+! substantially. For example, you can compute a {\tt sharedIndices}
+! structure once for a given pair of {\tt AttrVect}s, then use that same
+! structure for all copies between those two {\tt AttrVect}s (although
+! note that a different {\tt sharedIndices} variable would be needed if
+! {\tt aVin} and {\tt aVout} were reversed).
+!
+! {\bf N.B.:}  This routine will fail if the {\tt aVout} is not initialized.
+!
+! !INTERFACE:
+
+ subroutine RCopy_(aVin, aVout, vector, sharedIndices)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : GetSharedListIndices
+      use m_List,          only : GetIndices => get_indices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)    :: aVin
+      logical, optional,          intent(in)    :: vector 
+      type(AVSharedIndicesOneType), optional, intent(in) :: sharedIndices
+
+! !OUTPUT PARAMETERS: 
+
+      type(AttrVect),             intent(inout) :: aVout
+
+
+! !REVISION HISTORY:
+! 18Aug06 - R. Jacob <jacob@mcs.anl.gov> - initial version.
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - added sharedIndices argument
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::RCopy_'
+
+  integer :: i,j,ier       ! dummy variables
+  integer :: aVsize        ! The lsize of aVin and aVout
+  integer :: num_inindices, num_outindices   ! Number of matching indices in aV
+  integer :: inxmin, outxmin, inx, outx      ! Index variables
+  logical :: usevector    ! true if vector flag is present and true.
+  character*7 :: data_flag ! character variable used as data type flag
+  type(AVSharedIndicesOneType) :: mySharedIndices  ! copied from sharedIndices, or
+                                                   ! computed if sharedIndices is not
+                                                   ! present
+  logical :: clean_mySharedIndices ! true if we need to clean mySharedIndices before
+                                   ! returning (will be true if we did allocation in this
+                                   ! subroutine)
+
+
+  ! Check the arguments
+  aVsize = lsize_(aVin)
+  if(lsize_(aVin) /= lsize_(aVout)) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR: Input aV and output aV do not have the same size'
+     call die(myname_,'MCTERROR: Input aV and output aV &
+                       &do not have the same size',2)
+  endif
+
+  data_flag = 'REAL'
+
+  if (present(sharedIndices)) then
+     ! do some error checking on sharedIndices
+     if (.not. (associated(sharedIndices%aVindices1) .and. associated(sharedIndices%aVindices2))) then
+        call die(myname_,'MCTERROR: provided sharedIndices structure is uninitialized',3)
+     endif
+     if (trim(sharedIndices%data_flag) /= data_flag) then
+        call die(myname_,'MCTERROR: provided sharedIndices structure has incorrect data_flag',4)
+     endif
+
+     ! copy into local variable
+     mySharedIndices = sharedIndices
+     clean_mySharedIndices = .false.
+  else
+     ! Check REAL attributes for matching indices
+     call SharedIndicesOneType_(aVin, aVout, data_flag, mySharedIndices)
+     clean_mySharedIndices = .true.
+  endif
+
+  if(mySharedIndices%num_indices <= 0) then
+    if (clean_mySharedIndices) then
+       call cleanSharedIndicesOneType_(mySharedIndices,stat=ier)
+       if(ier /= 0) call die(myname_,'MCTERROR: in cleanSharedIndicesOneType_',ier)
+    endif
+    return
+  endif
+
+  ! check vector flag.
+  usevector = .false.
+  if (present(vector)) then
+   if(vector) usevector = .true.
+  endif
+
+  ! Start copying 
+
+  if(mySharedIndices%contiguous) then
+
+     if(usevector) then
+        outxmin=mySharedIndices%aVindices2(1)-1
+        inxmin=mySharedIndices%aVindices1(1)-1
+!$OMP PARALLEL DO PRIVATE(i,j)
+        do i=1,mySharedIndices%num_indices
+!CDIR SELECT(VECTOR)
+!DIR$ CONCURRENT
+           do j=1,aVsize
+              aVout%rAttr(outxmin+i,j) = aVin%rAttr(inxmin+i,j)
+           enddo
+        enddo
+     else
+        outxmin=mySharedIndices%aVindices2(1)-1
+        inxmin=mySharedIndices%aVindices1(1)-1
+!$OMP PARALLEL DO PRIVAtE(j,i)
+        do j=1,aVsize
+!DIR$ CONCURRENT
+           do i=1,mySharedIndices%num_indices
+              aVout%rAttr(outxmin+i,j) = aVin%rAttr(inxmin+i,j)
+           enddo
+        enddo
+     endif
+
+  else
+          
+!$OMP PARALLEL DO PRIVATE(j,i,outx,inx) 
+     do j=1,aVsize
+!DIR$ CONCURRENT
+        do i=1,mySharedIndices%num_indices
+           outx=mySharedIndices%aVindices2(i)
+           inx=mySharedIndices%aVindices1(i)     
+           aVout%rAttr(outx,j) = aVin%rAttr(inx,j)
+        enddo
+     enddo
+        
+  endif
+
+
+  if (clean_mySharedIndices) then
+     call cleanSharedIndicesOneType_(mySharedIndices,stat=ier)
+     if(ier /= 0) call die(myname_,'MCTERROR: in cleanSharedIndicesOneType_',ier)
+  endif
+
+ end subroutine RCopy_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: RCopyL_ - Copy Specific Real Attributes from One AttrVect to Another
+!
+! !DESCRIPTION:
+! This routine copies from input argment {\tt aVin} into the output 
+! {\tt AttrVect} argument {\tt aVout} the real attributes specified in 
+! input {\tt CHARACTER} argument {\tt rList}. The attributes can
+! be listed in any order.  
+!
+! If any attributes in {\tt aVout} have different names but represent the
+! the same quantity and should still be copied, you must provide a translation
+! argument {\tt TrList}.  The translation arguments should
+! be identical in length to the {\tt rList} but with the correct {\tt aVout}
+! name subsititued at the appropriate place.
+!
+! If the optional argument {\tt Vector} is present and true, the vector 
+! architecture-friendly portions of this routine will be invoked.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt aVout} is not initialized or
+! if any of the specified attributes are not present in either {\tt aVout} or {\tt aVin}.
+!
+! !INTERFACE:
+
+ subroutine RCopyL_(aVin, aVout, rList, TrList,  vector)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : GetSharedListIndices
+      use m_List,          only : GetIndices => get_indices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)    :: aVin
+      character(len=*),           intent(in)    :: rList
+      character(len=*), optional, intent(in)    :: TrList
+      logical, optional,          intent(in)    :: vector 
+
+! !OUTPUT PARAMETERS: 
+
+      type(AttrVect),             intent(inout) :: aVout
+
+
+! !REVISION HISTORY:
+! 16Aug06 - R. Jacob <jacob@mcs.anl.gov> - initial version from breakup
+!           of Copy_.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::RCopyL_'
+
+  integer :: i,j,ier       ! dummy variables
+  integer :: num_indices   ! Overlapping attribute index number
+  integer :: aVsize        ! The lsize of aVin and aVout
+  integer :: num_inindices, num_outindices   ! Number of matching indices in aV
+  integer :: inxmin, outxmin, inx, outx      ! Index variables
+  logical :: TrListIsPresent   ! true if list argument is present
+  logical :: contiguous    ! true if index segments are contiguous in memory  
+  logical :: usevector    ! true if vector flag is present and true.
+  character*7 :: data_flag ! character variable used as data type flag
+
+  ! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: aVinindices, aVoutindices
+
+
+  ! Check the arguments
+  aVsize = lsize_(aVin)
+  if(lsize_(aVin) /= lsize_(aVout)) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR: Input aV and output aV do not have the same size'
+     call die(myname_,'MCTERROR: Input aV and output aV &
+                       &do not have the same size',2)
+  endif
+
+  if(len_trim(rList) <= 0) return
+  ! Copy the listed real attributes
+
+  ! Index rList with the AttrVects
+  call GetIndices(aVinindices,aVin%rList,trim(rList))
+	
+!  TrList is present if it is provided and its length>0
+  TrListIsPresent = .false.
+  if(present(TrList)) then
+     if(len_trim(TrList) > 0) then
+       TrListIsPresent = .true.
+     endif
+  endif
+
+  if(TrListIsPresent) then
+     call GetIndices(aVoutindices,aVout%rList,trim(TrList))
+
+     if(size(aVinindices) /= size(aVoutindices)) then
+       call die(myname_,"Arguments rList and TrList do not&
+             &contain the same number of items")
+     endif
+  else
+       call GetIndices(aVoutindices,aVout%rList,trim(rList))
+  endif
+
+  num_indices=size(aVoutindices)
+
+  ! nothing to do if num_indices <=0
+  if (num_indices <= 0) then
+    deallocate(aVinindices, aVoutindices, stat=ier)
+    if(ier/=0) call die(myname_,"deallocate(aVinindices...)",ier)
+    return
+  endif
+ 
+  ! check vector flag.
+  usevector = .false.
+  if (present(vector)) then
+   if(vector) usevector = .true.
+  endif
+
+! Check if the indices are contiguous in memory for faster copy
+  contiguous=.true.
+  do i=2,num_indices
+     if(aVinindices(i) /= aVinindices(i-1)+1) contiguous = .false.
+  enddo
+  if(contiguous) then
+     do i=2,num_indices
+         if(aVoutindices(i) /= aVoutindices(i-1)+1) contiguous=.false.
+     enddo
+  endif
+
+! Start copying (arranged loop order optimized for xlf90)
+  if(contiguous) then
+
+     if(usevector) then
+        outxmin=aVoutindices(1)-1
+        inxmin=aVinindices(1)-1
+!$OMP PARALLEL DO PRIVATE(i,j)
+        do i=1,num_indices
+!DIR$ CONCURRENT
+	   do j=1,aVsize
+	     aVout%rAttr(outxmin+i,j) = aVin%rAttr(inxmin+i,j)       
+	   enddo
+	enddo
+     else
+        outxmin=aVoutindices(1)-1
+        inxmin=aVinindices(1)-1
+!$OMP PARALLEL DO PRIVATE(j,i)
+        do j=1,aVsize
+!DIR$ CONCURRENT
+	   do i=1,num_indices
+	      aVout%rAttr(outxmin+i,j) = aVin%rAttr(inxmin+i,j)       
+	   enddo
+	enddo
+     endif
+
+  else
+
+!$OMP PARALLEL DO PRIVATE(j,i,outx,inx)
+    do j=1,aVsize
+!DIR$ CONCURRENT
+       do i=1,num_indices
+          outx=aVoutindices(i)
+          inx=aVinindices(i)     
+          aVout%rAttr(outx,j) = aVin%rAttr(inx,j)
+       enddo
+    enddo
+
+  endif
+
+  deallocate(aVinindices, aVoutindices, stat=ier)
+  if(ier/=0) call die(myname_,"deallocate(aVinindices...)",ier)
+
+ end subroutine RCopyL_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ICopy_ - Copy Integer Attributes from One AttrVect to Another
+!
+! !DESCRIPTION:
+! This routine copies from input argment {\tt aVin} into the output 
+! {\tt AttrVect} argument {\tt aVout} the shared integer attributes.
+!
+! If the optional argument {\tt Vector} is present and true, the vector 
+! architecture-friendly portions of this routine will be invoked.
+!
+! If the optional argument {\tt sharedIndices} is present, it should be
+! the result of the call {\tt SharedIndicesOneType\_(aVin, aVout, 'INTEGER',
+! sharedIndices)}. Providing this argument speeds up this routine
+! substantially. For example, you can compute a {\tt sharedIndices}
+! structure once for a given pair of {\tt AttrVect}s, then use that same
+! structure for all copies between those two {\tt AttrVect}s (although
+! note that a different {\tt sharedIndices} variable would be needed if
+! {\tt aVin} and {\tt aVout} were reversed).
+!
+! {\bf N.B.:}  This routine will fail if the {\tt aVout} is not initialized.
+!
+! !INTERFACE:
+
+ subroutine ICopy_(aVin, aVout, vector, sharedIndices)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : GetSharedListIndices
+      use m_List,          only : GetIndices => get_indices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)    :: aVin
+      logical, optional,          intent(in)    :: vector 
+      type(AVSharedIndicesOneType), optional, intent(in) :: sharedIndices
+
+! !OUTPUT PARAMETERS: 
+
+      type(AttrVect),             intent(inout) :: aVout
+
+
+! !REVISION HISTORY:
+! 16Aug06 - R. Jacob <jacob@mcs.anl.gov> - initial version.
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - added sharedIndices argument
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ICopy_'
+
+  integer :: i,j,ier       ! dummy variables
+  integer :: aVsize        ! The lsize of aVin and aVout
+  integer :: num_inindices, num_outindices   ! Number of matching indices in aV
+  integer :: inxmin, outxmin, inx, outx      ! Index variables
+  logical :: usevector    ! true if vector flag is present and true.
+  character*7 :: data_flag ! character variable used as data type flag
+  type(AVSharedIndicesOneType) :: mySharedIndices  ! copied from sharedIndices, or
+                                                   ! computed if sharedIndices is not
+                                                   ! present
+  logical :: clean_mySharedIndices ! true if we need to clean mySharedIndices before
+                                   ! returning (will be true if we did allocation in this
+                                   ! subroutine)
+
+
+  ! Check the arguments
+  aVsize = lsize_(aVin)
+  if(lsize_(aVin) /= lsize_(aVout)) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR: Input aV and output aV do not have the same size'
+     call die(myname_,'MCTERROR: Input aV and output aV &
+                       &do not have the same size',2)
+  endif
+
+  data_flag = 'INTEGER'
+  
+  if (present(sharedIndices)) then
+     ! do some error checking on sharedIndices
+     if (.not. (associated(sharedIndices%aVindices1) .and. associated(sharedIndices%aVindices2))) then
+        call die(myname_,'MCTERROR: provided sharedIndices structure is uninitialized',3)
+     endif
+     if (trim(sharedIndices%data_flag) /= data_flag) then
+        call die(myname_,'MCTERROR: provided sharedIndices structure has incorrect data_flag',4)
+     endif
+
+     ! copy into local variable
+     mySharedIndices = sharedIndices
+     clean_mySharedIndices = .false.
+  else
+     ! Check INTEGER attributes for matching indices
+     call SharedIndicesOneType_(aVin, aVout, data_flag, mySharedIndices)
+     clean_mySharedIndices = .true.
+  endif
+
+  if(mySharedIndices%num_indices <= 0) then
+    if (clean_mySharedIndices) then
+       call cleanSharedIndicesOneType_(mySharedIndices,stat=ier)
+       if(ier /= 0) call die(myname_,'MCTERROR: in cleanSharedIndicesOneType_',ier)
+    endif
+    return
+  endif
+
+  ! check vector flag.
+  usevector = .false.
+  if (present(vector)) then
+   if(vector) usevector = .true.
+  endif
+
+
+  if(mySharedIndices%contiguous) then
+      
+     if(usevector) then
+        outxmin=mySharedIndices%aVindices2(1)-1
+        inxmin=mySharedIndices%aVindices1(1)-1
+!$OMP PARALLEL DO PRIVATE(i,j)
+        do i=1,mySharedIndices%num_indices
+!CDIR SELECT(VECTOR)
+!DIR$ CONCURRENT
+           do j=1,aVsize
+              aVout%iAttr(outxmin+i,j) = aVin%iAttr(inxmin+i,j)
+           enddo
+        enddo
+     else
+        outxmin=mySharedIndices%aVindices2(1)-1
+        inxmin=mySharedIndices%aVindices1(1)-1
+!$OMP PARALLEL DO PRIVATE(j,i)
+        do j=1,aVsize
+!DIR$ CONCURRENT
+           do i=1,mySharedIndices%num_indices
+              aVout%iAttr(outxmin+i,j) = aVin%iAttr(inxmin+i,j)
+           enddo
+        enddo
+     endif
+
+  else
+
+!$OMP PARALLEL DO PRIVATE(j,i,outx,inx)
+     do j=1,aVsize
+!DIR$ CONCURRENT
+        do i=1,mySharedIndices%num_indices
+           outx=mySharedIndices%aVindices2(i)
+           inx=mySharedIndices%aVindices1(i)     
+           aVout%iAttr(outx,j) = aVin%iAttr(inx,j)
+        enddo
+     enddo
+     
+  endif
+
+  if (clean_mySharedIndices) then
+     call cleanSharedIndicesOneType_(mySharedIndices,stat=ier)
+     if(ier /= 0) call die(myname_,'MCTERROR: in cleanSharedIndicesOneType_',ier)
+  endif
+
+ end subroutine ICopy_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ICopyL_ - Copy Specific Integer Attributes from One AttrVect to Another
+!
+! !DESCRIPTION:
+! This routine copies from input argment {\tt aVin} into the output 
+! {\tt AttrVect} argument {\tt aVout} the integer attributes specified in 
+! input {\tt CHARACTER} argument {\tt iList}. The attributes can
+! be listed in any order. 
+!
+! If any attributes in {\tt aVout} have different names but represent the
+! the same quantity and should still be copied, you must provide a translation
+! argument {\tt TiList}.  The translation arguments should
+! be identical in length to the {\tt iList} but with the correct {\tt aVout}
+! name subsititued at the appropriate place.
+!
+! If the optional argument {\tt Vector} is present and true, the vector 
+! architecture-friendly portions of this routine will be invoked.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt aVout} is not initialized or
+! if any of the specified attributes are not present in either {\tt aVout} or {\tt aVin}.
+!
+! !INTERFACE:
+
+ subroutine ICopyL_(aVin, aVout, iList, TiList, vector)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : GetIndices => get_indices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)    :: aVin
+      character(len=*)          , intent(in)    :: iList
+      character(len=*), optional, intent(in)    :: TiList
+      logical, optional,          intent(in)    :: vector 
+
+! !OUTPUT PARAMETERS: 
+
+      type(AttrVect),             intent(inout) :: aVout
+
+
+! !REVISION HISTORY:
+! 16Aug06 - R. Jacob <jacob@mcs.anl.gov> - initial version from breakup
+!           of Copy_.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ICopyL_'
+
+  integer :: i,j,ier       ! dummy variables
+  integer :: num_indices   ! Overlapping attribute index number
+  integer :: aVsize        ! The lsize of aVin and aVout
+  integer :: num_inindices, num_outindices   ! Number of matching indices in aV
+  integer :: inxmin, outxmin, inx, outx      ! Index variables
+  logical :: TiListIsPresent     ! true if list argument is present
+  logical :: contiguous    ! true if index segments are contiguous in memory  
+  logical :: usevector    ! true if vector flag is present and true.
+  character*7 :: data_flag ! character variable used as data type flag
+
+  ! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: aVinindices, aVoutindices
+
+
+  ! Check the arguments
+  aVsize = lsize_(aVin)
+  if(lsize_(aVin) /= lsize_(aVout)) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR: Input aV and output aV do not have the same size'
+     call die(myname_,'MCTERROR: Input aV and output aV &
+                       &do not have the same size',2)
+  endif
+
+  if(len_trim(iList) <= 0) return
+  ! Copy the listed real attributes
+
+
+! Index rList with the AttrVects
+  call GetIndices(aVinindices,aVin%iList,trim(iList))
+
+! TiList is present if its provided and its length>0
+  TiListIsPresent = .false.
+  if(present(TiList)) then
+    if(len_trim(TiList) > 0) then
+      TiListIsPresent = .true.
+    endif
+  endif
+
+  if(TiListIsPresent) then
+     call GetIndices(aVoutindices,aVout%iList,trim(TiList))
+     if(size(aVinindices) /= size(aVoutindices)) then
+        call die(myname_,"Arguments iList and TiList do not&
+               &contain the same number of items")
+     endif
+  else
+     call GetIndices(aVoutindices,aVout%iList,trim(iList))
+  endif
+
+  num_indices=size(aVoutindices)
+
+  ! nothing to do if num_indices <=0
+  if (num_indices <= 0) then
+    deallocate(aVinindices, aVoutindices, stat=ier)
+    if(ier/=0) call die(myname_,"deallocate(aVinindices...)",ier)
+    return
+  endif
+
+  ! check vector flag.
+  usevector = .false.
+  if (present(vector)) then
+   if(vector) usevector = .true.
+  endif
+
+! Check if the indices are contiguous in memory for faster copy
+  contiguous=.true.
+  do i=2,num_indices
+    if(aVinindices(i) /= aVinindices(i-1)+1) contiguous = .false.
+  enddo
+  if(contiguous) then
+    do i=2,num_indices
+      if(aVoutindices(i) /= aVoutindices(i-1)+1) contiguous=.false.
+    enddo
+  endif
+	
+! Start copying (arranged loop order optimized for xlf90)
+  if(contiguous) then
+
+    if(usevector) then
+      outxmin=aVoutindices(1)-1
+      inxmin=aVinindices(1)-1
+!$OMP PARALLEL DO PRIVAtE(i,j)
+      do i=1,num_indices
+!CDIR SELECT(VECTOR)
+!DIR$ CONCURRENT
+         do j=1,aVsize
+   	    aVout%iAttr(outxmin+i,j) = aVin%iAttr(inxmin+i,j)       
+         enddo
+      enddo
+    else
+      outxmin=aVoutindices(1)-1
+      inxmin=aVinindices(1)-1
+!$OMP PARALLEL DO PRIVATE(j,i)
+      do j=1,aVsize
+!DIR$ CONCURRENT
+         do i=1,num_indices
+   	    aVout%iAttr(outxmin+i,j) = aVin%iAttr(inxmin+i,j)       
+         enddo
+      enddo
+    endif
+
+  else
+
+!$OMP PARALLEL DO PRIVATE(j,i,outx,inx)
+     do j=1,aVsize
+!DIR$ CONCURRENT
+       do i=1,num_indices
+          outx=aVoutindices(i)
+          inx=aVinindices(i)     
+          aVout%iAttr(outx,j) = aVin%iAttr(inx,j)
+       enddo
+     enddo
+
+  endif
+                
+  deallocate(aVinindices, aVoutindices, stat=ier)
+  if(ier/=0) call die(myname_,"deallocate(aVinindices...)",ier)
+
+ end subroutine ICopyL_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Copy_ - Copy Real and Integer Attributes from One AttrVect to Another
+!
+! !DESCRIPTION:
+! This routine copies from input argment {\tt aVin} into the output 
+! {\tt AttrVect} argument {\tt aVout} the real and integer attributes specified in 
+! input {\tt CHARACTER} argument {\tt iList} and {\tt rList}. The attributes can
+! be listed in any order.  If neither {\tt iList} nor {\tt rList} are provided, 
+! all attributes shared between {\tt aVin} and {\tt aVout} will be copied.
+!
+! If any attributes in {\tt aVout} have different names but represent the
+! the same quantity and should still be copied, you must provide a translation
+! argument {\tt TrList} and/or {\tt TiList}.  The translation arguments should
+! be identical to the {\tt rList} or {\tt iList} but with the correct {\tt aVout}
+! name subsititued at the appropriate place.
+!
+! This routines combines the functions of {\tt RCopy\_}, {\tt RCopyL\_},
+! {\tt ICopy\_} and {\tt ICopyL\_}.  If you know you only want to copy real
+! attributes, use the {\tt RCopy} functions.  If you know you only want to
+! copy integer attributes, use the {\tt ICopy} functions.
+!
+! If the optional argument {\tt Vector} is present and true, the vector 
+! architecture-friendly portions of this routine will be invoked.
+!
+! If the optional argument {\tt sharedIndices} is present, it should be
+! the result of the call {\tt SharedIndices\_(aVin, aVout,
+! sharedIndices)}. Providing this argument speeds up this routine
+! substantially. For example, you can compute a {\tt sharedIndices}
+! structure once for a given pair of {\tt AttrVect}s, then use that same
+! structure for all copies between those two {\tt AttrVect}s (although
+! note that a different {\tt sharedIndices} variable would be needed if
+! {\tt aVin} and {\tt aVout} were reversed). Note, however, that {\tt
+! sharedIndices} is ignored if either {\tt rList} or {\tt iList} are
+! given.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt aVout} is not initialized or
+! if any of the specified attributes are not present in either {\tt aVout} or {\tt aVin}.
+!
+! !INTERFACE:
+
+ subroutine Copy_(aVin, aVout, rList, TrList, iList, TiList, vector, sharedIndices)
+
+!
+! !USES:
+!
+      use m_die ,          only : die, warn
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : GetSharedListIndices
+      use m_List,          only : GetIndices => get_indices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(AttrVect),             intent(in)    :: aVin
+      character(len=*), optional, intent(in)    :: iList
+      character(len=*), optional, intent(in)    :: rList
+      character(len=*), optional, intent(in)    :: TiList
+      character(len=*), optional, intent(in)    :: TrList
+      logical, optional,          intent(in)    :: vector 
+      type(AVSharedIndices), optional, intent(in) :: sharedIndices
+
+! !OUTPUT PARAMETERS: 
+
+      type(AttrVect),             intent(inout) :: aVout
+
+
+! !REVISION HISTORY:
+! 12Jun02 - R. Jacob <jacob@mcs.anl.gov> - initial version.
+! 13Jun02 - R. Jacob <jacob@mcs.anl.gov> - copy shared attributes
+!           if no attribute lists are specified.
+! 30Sep02 - R. Jacob <jacob@mcs.anl.gov> - new argument order with all
+!           optional arguments last
+! 19Feb02 - E. Ong <eong@mcs.anl.gov> - new implementation using 
+!           new list function get_indices and faster memory copy  
+! 28Oct03 - R. Jacob <jacob@mcs.anl.gov> - add optional vector
+!           argument to use vector-friendly code provided by Fujitsu
+! 16Aug06 - R. Jacob <jacob@mcs.anl.gov> - split into 4 routines:
+!           RCopy_,RCopyL_,ICopy_,ICopyL_
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - added sharedIndices argument
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Copy_'
+
+  integer :: i,j,ier       ! dummy variables
+  integer :: num_indices   ! Overlapping attribute index number
+  integer :: aVsize        ! The lsize of aVin and aVout
+  integer :: num_inindices, num_outindices   ! Number of matching indices in aV
+  integer :: inxmin, outxmin, inx, outx      ! Index variables
+  logical :: TiListIsPresent, TrListIsPresent! true if list argument is present
+  logical :: contiguous    ! true if index segments are contiguous in memory  
+  logical :: usevector    ! true if vector flag is present and true.
+  character*7 :: data_flag ! character variable used as data type flag
+
+  ! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: aVinindices, aVoutindices
+
+
+  ! Check the arguments
+  aVsize = lsize_(aVin)
+  if(lsize_(aVin) /= lsize_(aVout)) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR: Input aV and output aV do not have the same size'
+     call die(myname_,'MCTERROR: Input aV and output aV &
+                       &do not have the same size',2)
+  endif
+
+  ! check vector flag.
+  usevector = .false.
+  if (present(vector)) then
+   if(vector) usevector = .true.
+  endif
+
+  ! Copy the listed real attributes
+  if(present(rList)) then
+	! TrList is present if it is provided and its length>0
+	TrListIsPresent = .false.
+	if(present(TrList)) then
+	   if(len_trim(TrList) > 0) then
+	      TrListIsPresent = .true.
+	   endif
+	endif
+
+        if(present(sharedIndices)) then
+           call warn(myname_,'Use of sharedIndices not implemented in RCopyL; &
+                     &ignoring sharedIndices',1)
+        end if
+
+	if(TrListIsPresent) then
+	   call RCopyL_(aVin,aVout,rList,TrList,vector=usevector)
+	else
+	   call RCopyL_(aVin,aVout,rList,vector=usevector)
+	endif
+
+  endif   ! if(present(rList)
+
+  !  Copy the listed integer attributes
+  if(present(iList)) then
+
+	! TiList is present if its provided and its length>0
+	TiListIsPresent = .false.
+	if(present(TiList)) then
+	   if(len_trim(TiList) > 0) then
+	      TiListIsPresent = .true.
+	   endif
+	endif
+
+        if(present(sharedIndices)) then
+           call warn(myname_,'Use of sharedIndices not implemented in ICopyL; &
+                     &ignoring sharedIndices',1)
+        end if
+
+	if(TiListIsPresent) then
+	   call ICopyL_(aVin,aVout,iList,TiList,vector=usevector)
+	else
+	   call ICopyL_(aVin,aVout,iList,vector=usevector)
+	endif
+
+  endif   ! if(present(iList))
+
+  ! If neither rList nor iList is present, copy shared attibutes
+  ! from in to out.
+  if( .not.present(rList) .and. .not.present(iList)) then
+
+     if (present(sharedIndices)) then
+        call RCopy_(aVin, Avout, vector=usevector, sharedIndices=sharedIndices%shared_real)
+        call ICopy_(aVin, Avout, vector=usevector, sharedIndices=sharedIndices%shared_integer)
+     else
+        call RCopy_(aVin, Avout, vector=usevector)
+        call ICopy_(aVin, Avout, vector=usevector)
+     endif
+
+  endif
+
+ end subroutine Copy_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Sort_ - Use Attributes as Keys to Generate an Index Permutation
+!
+! !DESCRIPTION:
+! The subroutine {\tt Sort\_()} uses a list of keys defined by the {\tt List} 
+! {\tt key\_list}, searches for the appropriate integer or real attributes
+! referenced by the items in {\tt key\_list} ( that is, it identifies the 
+! appropriate entries in {aV\%iList} and {\tt aV\%rList}), and then 
+! uses these keys to generate a permutation {\tt perm} that will put
+! the entries of the attribute vector {\tt aV} in lexicographic order
+! as defined by {\tt key\_list} (the ordering in {\tt key\_list} being from
+! left to right.
+!
+! {\bf N.B.:}  This routine will fail if {\tt aV\%iList} and 
+! {\tt aV\%rList} share one or more common entries. 
+!
+! {\bf N.B.:}  This routine will fail if one of the sorting keys presented is 
+! not present in {\tt aV\%iList} nor {\tt aV\%rList}.
+!
+! !INTERFACE:
+
+ subroutine Sort_(aV, key_list, perm, descend, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_String,        only : String
+      use m_String,        only : String_tochar => tochar
+      use m_String,        only : String_clean => clean
+      use m_List ,         only : List_allocated => allocated
+      use m_List ,         only : List_index => index
+      use m_List ,         only : List_nitem => nitem
+      use m_List ,         only : List_get   => get
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_SortingTools , only : IndexSet
+      use m_SortingTools , only : IndexSort
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),                  intent(in) :: aV
+      type(List),                      intent(in) :: key_list
+      logical, dimension(:), optional, intent(in) :: descend
+      character(len=*),      optional, intent(in) :: perrWith
+      character(len=*),      optional, intent(in) :: dieWith
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, dimension(:),           pointer    :: perm
+
+
+! !REVISION HISTORY:
+! 20Oct00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 25Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add -1 to make a
+!           backwards loop go backwards
+! 14Jun01 - J. Larson / E. Ong -- Fixed logic bug in REAL attribute
+!           sort (discovered by E. Ong), and cleaned up error / 
+!           shutdown logic.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Sort_'
+
+! local variables
+
+        ! storage for key extracted from key_list:
+
+  type(String) :: key
+
+        ! number of keys, loop index, error flag, and length:
+
+  integer :: nkeys, n, ierr, length
+
+        ! key indices for av%rAttr and av%iAttr, respectively:
+
+  integer, dimension(:), allocatable :: rIndex, iIndex 
+
+        ! copy of descend argument
+
+  logical, dimension(:), allocatable :: descend_copy
+
+        ! count the sorting keys:
+
+  nkeys = List_nitem(key_list)
+
+        ! Check the descend argument. Note: the unnecessary copy
+        ! circumvents an optimization bug in the compaq compiler
+
+  if(present(descend)) then
+     if(size(descend)/=nkeys) then
+        call die(myname_,"Size of descend argument is not equal &
+                  &to the number of keys")
+     endif
+     allocate(descend_copy(nkeys),stat=ierr)
+     if(ierr/=0) call die(myname_,"allocate(descend_copy)",ierr)
+     descend_copy=descend
+  endif
+     
+
+        ! allocate and initialize rIndex and iIndex to
+        ! zero (the null return values from the functions
+        ! indexRA_() and indexIA_() ).
+
+  allocate(rIndex(nkeys), iIndex(nkeys), stat=ierr)
+  if(ierr/=0) call die(myname_,"allocate(rindex,iIndex)",ierr)
+
+  rIndex = 0
+  iIndex = 0
+
+        ! Loop over the keys in the list, and identify the
+        ! appropriate integer or real attribute, storing the
+        ! attribute index in iIndex(:) or rIndex(:), respectively.
+
+  do n = 1, nkeys
+
+        ! grab the next key
+
+     call List_get(key, n, key_list)
+
+        ! determine wheter this key refers to an
+        ! integer or real attribute:
+! jwl commented out in favor of below code block unitl an error 
+! handling strategy is settled upon for indexIA_() and indexRA_().
+!     rIndex(n) = indexRA_(aV, String_tochar(key), dieWith=myname_)
+!     iIndex(n) = indexIA_(aV, String_tochar(key), dieWith=myname_)
+
+     if(List_allocated(aV%rList)) then
+	rIndex(n) = List_index(aV%rList, String_tochar(key))
+     else
+	rIndex(n) = 0
+     endif
+     if(List_allocated(aV%iList)) then
+	iIndex(n) = List_index(aV%iList, String_tochar(key))
+     else
+	iIndex(n) = 0
+     endif
+
+        ! If both rIndex(n) and iIndex(n) are greater than
+        ! zero, then we have an integer attribute sharing 
+        ! the same name as a real attribute, and there is 
+        ! no clear path as to which one is the sort key.
+        ! This is a fatal error that triggers shutdown.
+
+     if ((rIndex(n) > 0) .and. (iIndex(n) > 0)) then
+	if(.not.present(dieWith)) then
+	   if(present(perrWith)) write(stderr,'(4a)') myname, &
+		":: ambiguous key, ", perrWith, &
+		" both iIndex(n) and rIndex(n) positive."
+	    call die(myname_,":: both iIndex(n) and rIndex(n) > 0.")
+	else
+	   if(present(perrWith)) then
+	       write(stderr,'(4a)') myname_,":: ", perrWith, &
+		       " both iIndex(n) and rIndex(n) positive."
+           endif
+	   call die(myname_,dieWith)
+	endif
+     endif
+
+        ! If both rIndex(n) and iIndex(n) are nonpositive,
+        ! then the requested sort key is not present in either
+        ! aV%rList or aV%iList, and we cannot perform the sort.
+        ! This is a fatal error that triggers shutdown.
+
+     if ((rIndex(n) <= 0) .and. (iIndex(n) <= 0)) then
+	if(.not.present(dieWith)) then
+	   if(present(perrWith)) write(stderr,'(4a)') myname,":: ", &
+		perrWith, &
+		" both iIndex(n) and rIndex(n) nonpositive"
+	   call die(myname_,":: both iIndex(n) and rIndex(n) <= 0.")
+	else
+	   if(present(perrWith)) then
+	      write(stderr,'(4a)') myname_,":: ", perrWith,	&
+		   " both iIndex(n) and rIndex(n) nonpositive"
+           endif
+	   call die(myname_,dieWith)
+	endif
+     endif
+
+        ! If only one of rIndex(n) or iIndex(n) is positive,
+        ! set the other value to zero.
+
+     if (iIndex(n) > 0) rIndex(n) = 0
+     if (rIndex(n) > 0) iIndex(n) = 0
+
+        ! Clean up temporary string -key-
+
+     call String_clean(key)
+
+  enddo ! do n=1,nkeys
+
+        ! Now we have the locations of the keys in the integer and
+        ! real attribute storage areas aV%iAttr and aV%rAttr, respectively.
+        ! our next step is to construct and initialize the permutation
+        ! array perm.  First step--determine the length of aV using 
+        ! lsize_():
+
+  length = lsize_(aV)
+
+  allocate(perm(length), stat=ierr)
+  if(ierr/=0) call die(myname_,"allocate(perm)",ierr)
+
+        ! Initialize perm(i)=i, for i=1,length
+
+  call IndexSet(perm)
+
+        ! Now we can perform the stable successive keyed sorts to
+        ! transform perm into the permutation that will place the
+        ! entries of the attribute arrays in the lexicographic order
+        ! defined by key_list.  This is achieved by successive calls to
+        ! IndexSort(), but in reverse order to the order of the keys
+        ! as they appear in key_list.
+
+  do n=nkeys, 1, -1
+     if(iIndex(n) > 0) then
+	if(present(descend)) then
+	   call IndexSort(length, perm, aV%iAttr(iIndex(n),:), &
+		          descend_copy(n))
+	else
+   	   call IndexSort(length, perm, aV%iAttr(iIndex(n),:), &
+               		  descend=.false.)
+	endif ! if(present(descend)...
+     else
+	if(rIndex(n) > 0) then
+	   if(present(descend)) then
+	      call IndexSort(length, perm, aV%rAttr(rIndex(n),:), &
+		             descend_copy(n))
+	   else
+	      call IndexSort(length, perm, aV%rAttr(rIndex(n),:), &
+               		     descend=.false.)
+	   endif ! if(present(descend)...
+	endif ! if (rIndex(n) > 0)...
+     endif ! if (iIndex(n) > 0)...
+  enddo
+
+        ! Now perm(1:length) is the transformation we seek--we are
+        ! finished.
+
+  deallocate(iIndex, rIndex, stat=ierr)  ! clean up allocated arrays.
+  if(ierr/=0) call die(myname_,"deallocate(iIndex,rIndex)",ierr)
+
+  if(present(descend)) deallocate(descend_copy,stat=ierr)
+  if(ierr/=0) call die(myname_,"deallocate(descend_copy)",ierr)
+
+ end subroutine Sort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Permute_ - Permute AttrVect Elements
+!
+! !DESCRIPTION:
+! The subroutine {\tt Permute\_()} uses a a permutation {\tt perm} (which can
+! be generated by the routine {\tt Sort\_()} in this module) to rearrange
+! the entries in the attribute integer and real storage areas of the
+! input attribute vector {\tt aV}--{\tt aV\%iAttr} and {\tt aV\%rAttr}, 
+! respectively.
+!
+! !INTERFACE:
+
+ subroutine Permute_(aV, perm, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_SortingTools , only : Permute
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer, dimension(:),           intent(in)    :: perm
+      character(len=*),      optional, intent(in)    :: perrWith
+      character(len=*),      optional, intent(in)    :: dieWith
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),                  intent(inout) :: aV
+
+! !REVISION HISTORY:
+! 23Oct00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Permute_'
+
+! local variables
+
+  integer :: i
+
+        ! Check input arguments for compatibility--assure
+        ! lsize_(aV) = size(perm); that is, make sure the
+        ! index permutation is the same length as the vectors
+        ! it will re-arrange.
+
+  if (size(perm) /= lsize_(aV)) then
+     if(.not.present(dieWith)) then
+	if(present(perrWith)) write(stderr,'(4a,i8,a,i8)') myname, &
+	  ":: size mismatch, ", perrWith, &
+	  "size(perm)=",size(perm)," lsize_(aV)=",lsize_(aV)
+     else
+	write(stderr,'(4a,i8,a,i8)') myname, &
+	 ":: size mismatch, ", dieWith,	&
+	 "size(perm)=",size(perm)," lsize_(aV)=",lsize_(aV)
+	call die(dieWith)
+     endif
+  endif
+
+  if(size(perm) == lsize_(aV)) then
+
+        ! Permute integer attributes:
+     if(nIAttr_(aV) /= 0) then
+	do i=1,nIAttr_(aV)
+	   call Permute(aV%iAttr(i,:),perm,lsize_(aV))
+	end do
+     endif
+
+        ! Permute real attributes:
+     if(nRAttr_(aV) /= 0) then
+	do i=1,nRAttr_(aV)
+	   call Permute(aV%rAttr(i,:),perm,lsize_(aV))
+	end do
+     endif
+
+  endif
+
+ end subroutine Permute_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Unpermute_ - Unpermute AttrVect Elements
+!
+! !DESCRIPTION:
+! The subroutine {\tt Unpermute\_()} uses a a permutation {\tt perm} (which can
+! be generated by the routine {\tt Sort\_()} in this module) to rearrange
+! the entries in the attribute integer and real storage areas of the
+! input attribute vector {\tt aV}--{\tt aV\%iAttr} and {\tt aV\%rAttr}, 
+! respectively.  This is meant to be called on an {\tt aV} that has already
+! been permuted but it could also be used to perform the inverse operation
+! implied by {\tt perm} on an unpermuted {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine Unpermute_(aV, perm, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_SortingTools , only : Unpermute
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer, dimension(:),           intent(in)    :: perm
+      character(len=*),      optional, intent(in)    :: perrWith
+      character(len=*),      optional, intent(in)    :: dieWith
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),                  intent(inout) :: aV
+
+! !REVISION HISTORY:
+! 23Nov05 - R. Jacob <jacob@mcs.anl.gov> - based on Permute
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Unpermute_'
+
+! local variables
+
+  integer :: i
+
+        ! Check input arguments for compatibility--assure
+        ! lsize_(aV) = size(perm); that is, make sure the
+        ! index permutation is the same length as the vectors
+        ! it will re-arrange.
+
+  if (size(perm) /= lsize_(aV)) then
+     if(.not.present(dieWith)) then
+	if(present(perrWith)) write(stderr,'(4a,i8,a,i8)') myname, &
+	  ":: size mismatch, ", perrWith, &
+	  "size(perm)=",size(perm)," lsize_(aV)=",lsize_(aV)
+     else
+	write(stderr,'(4a,i8,a,i8)') myname, &
+	 ":: size mismatch, ", dieWith,	&
+	 "size(perm)=",size(perm)," lsize_(aV)=",lsize_(aV)
+	call die(dieWith)
+     endif
+  endif
+
+  if(size(perm) == lsize_(aV)) then
+
+        ! Unpermute integer attributes:
+     if(nIAttr_(aV) /= 0) then
+	do i=1,nIAttr_(aV)
+	   call Unpermute(aV%iAttr(i,:),perm,lsize_(aV))
+	end do
+     endif
+
+        ! Permute real attributes:
+     if(nRAttr_(aV) /= 0) then
+	do i=1,nRAttr_(aV)
+	   call Unpermute(aV%rAttr(i,:),perm,lsize_(aV))
+	end do
+     endif
+
+  endif
+
+ end subroutine Unpermute_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SortPermute_ - In-place Lexicographic Sort of an AttrVect
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt SortPermute\_()} uses the routine {\tt Sort\_()} 
+! to create an index permutation {\tt perm} that will place the AttrVect
+! entries in the lexicographic order defined by the keys in the List 
+! variable {\tt key\_list}.  This permutation is then used by the routine
+! {\tt Permute\_()} to place the AttreVect entries in lexicographic order.
+!
+! !INTERFACE:
+
+ subroutine SortPermute_(aV, key_list, descend, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),                       intent(in)    :: key_list
+      logical , dimension(:), optional, intent(in)    :: descend
+      character(len=*),       optional, intent(in)    :: perrWith
+      character(len=*),       optional, intent(in)    :: dieWith
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),                   intent(inout) :: aV
+
+! !REVISION HISTORY:
+! 24Oct00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Permute_'
+
+! local variables
+
+       ! Permutation array pointer perm(:)
+  integer, dimension(:), pointer :: perm
+       ! Error flag ierr
+  integer :: ierr
+
+       ! Step One: Generate the index permutation perm(:)
+
+  if(present(descend)) then
+     call Sort_(aV, key_list, perm, descend, perrWith, dieWith)
+  else
+     call Sort_(aV, key_list, perm, perrWith=perrWith, &
+	        dieWith=dieWith)
+  endif
+
+       ! Step Two:  Apply the index permutation perm(:)
+
+  call Permute_(aV, perm, perrWith, dieWith)
+
+       ! Step Three:  deallocate temporary array used to 
+       ! store the index permutation (this was allocated 
+       ! in the routine Sort_()
+
+  deallocate(perm, stat=ierr)
+
+  end subroutine SortPermute_
+
+! Sorting:
+!
+!	aV%iVect(:,:) =		&
+!		aV%iVect((/(indx(i),i=1,lsize(aV))/),:)
+!
+!	aV%iVect((/(indx(i),i=1,lsize(aV))/),:) =	&
+!		aV%iVect(:,:)
+!
+!	aV%iVect(:,ikx),aV%iVect(:,iks)
+!
+!
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: aVaVSharedAttrIndexList_ - AttrVect shared attributes.
+!
+! !DESCRIPTION:  {\tt aVaVSharedAttrIndexList\_()} takes a pair of 
+! user-supplied {\tt AttrVect} variables {\tt aV1} and {\tt aV2}, 
+! and for choice of either {\tt REAL} or {\tt INTEGER} attributes (as
+! specified literally in the input {\tt CHARACTER} argument {\tt attrib})
+! returns the number of shared attributes {\tt NumShared}, and arrays of
+! indices {\tt Indices1} and {\tt Indices2} to their storage locations
+! in {\tt aV1} and {\tt aV2}, respectively.
+!
+! {\bf N.B.:}  This routine returns two allocated arrays---{\tt Indices1(:)} 
+! and {\tt Indices2(:)}---which must be deallocated once the user no longer
+! needs them.  Failure to do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine aVaVSharedAttrIndexList_(aV1, aV2, attrib, NumShared, &
+                                     Indices1, Indices2)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die,      only : MP_perr_die, die, warn
+
+      use m_List,     only : GetSharedListIndices
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),        intent(in)  :: aV1   
+      type(AttrVect),        intent(in)  :: aV2
+      character(len=*),      intent(in)  :: attrib
+
+! !OUTPUT PARAMETERS:   
+!
+      integer,               intent(out) :: NumShared
+      integer, dimension(:), pointer     :: Indices1
+      integer, dimension(:), pointer     :: Indices2
+
+! !REVISION HISTORY:
+! 07Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::aVaVSharedAttrIndexList_'
+
+  integer :: ierr
+
+       ! Based on the value of the argument attrib, pass the 
+       ! appropriate pair of Lists for comparison...
+
+  select case(trim(attrib))
+  case('REAL','real')
+     call GetSharedListIndices(aV1%rList, aV2%rList, NumShared, &
+                                 Indices1, Indices2)
+  case('INTEGER','integer')
+     call GetSharedListIndices(aV1%iList, aV2%iList, NumShared, &
+                                 Indices1, Indices2)
+  case default
+     write(stderr,'(4a)') myname_,":: value of argument attrib=",attrib, &
+          " not recognized.  Allowed values: REAL, real, INTEGER, integer"
+     ierr = 1
+     call die(myname_, 'invalid value for attrib', ierr)
+  end select
+
+ end subroutine aVaVSharedAttrIndexList_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Climate and Global Dynamics Division, National Center for Atmospheric Research !
+!BOP -----------------------------------------------------------------------------
+!
+! !IROUTINE: SharedIndices_ - AttrVect shared attributes and auxiliary information
+!
+! !DESCRIPTION:  {\tt SharedIndices\_()} takes a pair of user-supplied
+! {\tt AttrVect} variables {\tt aV1} and {\tt aV2}, and returns a
+! structure of type {\tt AVSharedIndices} ({\tt sharedIndices}).  This
+! structure contains arrays of indices to the locations of the shared
+! attributes, as well as auxiliary information.  The structure contains
+! information on both the {\tt REAL} and {\tt INTEGER} attributes.  See
+! documentation for the {\tt SharedIndicesOneType\_} subroutine for some
+! additional details, as much of the work is done there.
+!
+! {\bf N.B.:} The returned structure, {\tt sharedIndices}, contains
+! allocated arrays that must be deallocated once the user no longer
+! needs them.  This should be done through a call to {\tt
+! cleanSharedIndices\_}.
+!
+! !INTERFACE:
+
+ subroutine SharedIndices_(aV1, aV2, sharedIndices)
+
+    implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),        intent(in)  :: aV1   
+      type(AttrVect),        intent(in)  :: aV2
+
+! !INPUT/OUTPUT PARAMETERS:   
+!
+      type(AVSharedIndices), intent(inout) :: sharedIndices
+
+! !REVISION HISTORY:
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SharedIndices_'
+
+  call SharedIndicesOneType_(aV1, aV2, 'REAL', sharedIndices%shared_real)
+  call SharedIndicesOneType_(aV1, aV2, 'INTEGER', sharedIndices%shared_integer)
+
+ end subroutine SharedIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Climate and Global Dynamics Division, National Center for Atmospheric Research !
+!BOP -----------------------------------------------------------------------------
+!
+! !IROUTINE: SharedIndicesOneType_ - AttrVect shared attributes and auxiliary information, for one data type
+!
+! !DESCRIPTION:  {\tt SharedIndicesOneType\_()} takes a pair of
+! user-supplied {\tt AttrVect} variables {\tt aV1} and {\tt aV2}, and
+! for choice of either {\tt REAL} or {\tt INTEGER} attributes (as
+! specified literally in the input {\tt CHARACTER} argument {\tt
+! attrib}) returns a structure of type {\tt AVSharedIndicesOneType} ({\tt
+! sharedIndices}).  This structure contains arrays of indices to the
+! locations of the shared attributes of the given type, as well as
+! auxiliary information.
+!
+! The {\tt aVindices1} and {\tt aVindices2} components of {\tt
+! sharedIndices} will be indices into {\tt aV1} and {\tt aV2},
+! respectively.
+!
+! {\bf N.B.:} The returned structure, {\tt sharedIndices}, contains
+! allocated arrays that must be deallocated once the user no longer
+! needs them.  This should be done through a call to {\tt
+! cleanSharedIndicesOneType\_}.  Even if there are no attributes in
+! common between {\tt aV1} and {\tt aV2}, {\tt sharedIndices} will still
+! be initialized, and memory will still be allocated. Furthermore, if an
+! already-initialized {\tt sharedIndices} variable is to be given new
+! values, {\tt cleanSharedIndicesOneType\_} must be called before {\tt
+! SharedIndicesOneType\_} is called a second time, in order to prevent a
+! memory leak.
+!
+! !INTERFACE:
+
+ subroutine SharedIndicesOneType_(aV1, aV2, attrib, sharedIndices)
+
+    implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),        intent(in)  :: aV1   
+      type(AttrVect),        intent(in)  :: aV2
+      character(len=*),      intent(in)  :: attrib
+
+! !INPUT/OUTPUT PARAMETERS:   
+!
+      type(AVSharedIndicesOneType), intent(inout) :: sharedIndices
+
+! !REVISION HISTORY:
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SharedIndicesOneType_'
+  integer :: i
+
+  ! Check appropriate attributes (real or integer) for matching indices
+  call aVaVSharedAttrIndexList_(aV1, aV2, attrib, sharedIndices%num_indices, &
+                                   sharedIndices%aVindices1, sharedIndices%aVindices2)
+
+  sharedIndices%data_flag = attrib
+
+  ! Check indices for contiguous segments in memory
+  sharedIndices%contiguous=.true.
+  do i=2,sharedIndices%num_indices
+     if(sharedIndices%aVindices1(i) /= sharedIndices%aVindices1(i-1)+1) then 
+        sharedIndices%contiguous = .false.
+     endif
+  enddo
+  if(sharedIndices%contiguous) then
+     do i=2,sharedIndices%num_indices
+        if(sharedIndices%aVindices2(i) /= sharedIndices%aVindices2(i-1)+1) then
+           sharedIndices%contiguous=.false.
+        endif
+     enddo
+  endif
+
+ end subroutine SharedIndicesOneType_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Climate and Global Dynamics Division, National Center for Atmospheric Research !
+!BOP -----------------------------------------------------------------------------
+!
+! !IROUTINE: cleanSharedIndices_ - Deallocate allocated memory structures of an AVSharedIndices structure
+!
+! !DESCRIPTION: This routine deallocates the allocated memory structures
+! of the input/output {\tt AVSharedIndicesOneType} argument {\tt
+! sharedIndices}, if they are currently associated.  It also resets
+! other components of this structure to a default state.  The success
+! (failure) of this operation is signified by a zero (non-zero) value of
+! the optional {\tt INTEGER} output argument {\tt stat}.  If {\tt
+! clean\_()} is invoked without supplying {\tt stat}, and any of the
+! deallocation operations fail, the routine will terminate with an error
+! message.  If multiple errors occur, {\tt stat} will give the error
+! condition for the last error.
+!
+! !INTERFACE:
+
+ subroutine cleanSharedIndices_(sharedIndices, stat)
+
+    implicit none
+
+! !INPUT/OUTPUT PARAMETERS:   
+!
+      type(AVSharedIndices), intent(inout) :: sharedIndices
+
+! !OUTPUT PARAMETERS:
+!
+      integer, optional, intent(out)       :: stat
+
+! !REVISION HISTORY:
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::cleanSharedIndices_'
+  integer :: ier
+
+  if(present(stat)) stat=0
+
+  call cleanSharedIndicesOneType_(sharedIndices%shared_real, stat=ier)
+  if(present(stat) .and. ier /= 0) then
+     stat = ier
+  end if
+
+  call cleanSharedIndicesOneType_(sharedIndices%shared_integer, stat=ier)
+  if(present(stat) .and. ier /= 0) then
+     stat = ier
+  end if
+
+ end subroutine cleanSharedIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! Climate and Global Dynamics Division, National Center for Atmospheric Research !
+!BOP -----------------------------------------------------------------------------
+!
+! !IROUTINE: cleanSharedIndicesOneType_ - Deallocate allocated memory structures of an AVSharedIndicesOneType structure
+!
+! !DESCRIPTION: This routine deallocates the allocated memory structures
+! of the input/output {\tt AVSharedIndices} argument {\tt
+! sharedIndices}, if they are currently associated.  It also resets
+! other components of this structure to a default state.  The success
+! (failure) of this operation is signified by a zero (non-zero) value of
+! the optional {\tt INTEGER} output argument {\tt stat}.  If {\tt
+! clean\_()} is invoked without supplying {\tt stat}, and any of the
+! deallocation operations fail, the routine will terminate with an error
+! message.  If multiple errors occur, {\tt stat} will give the error
+! condition for the last error.
+!
+! !INTERFACE:
+
+ subroutine cleanSharedIndicesOneType_(sharedIndices, stat)
+!
+! !USES:
+!
+      use m_die,      only : die
+
+    implicit none
+
+! !INPUT/OUTPUT PARAMETERS:   
+!
+      type(AVSharedIndicesOneType), intent(inout) :: sharedIndices
+
+! !OUTPUT PARAMETERS:
+!
+      integer, optional, intent(out)       :: stat
+
+! !REVISION HISTORY:
+! 28Apr11 - W.J. Sacks <sacks@ucar.edu> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::cleanSharedIndicesOneType_'
+  integer :: ier
+
+  if(present(stat)) stat=0
+
+  if(associated(sharedIndices%aVindices1)) then
+     
+     deallocate(sharedIndices%aVindices1,stat=ier)
+
+     if (ier /= 0) then
+        if(present(stat)) then
+           stat=ier
+        else
+           call die(myname_,'deallocate(sharedIndices%aVindices1)',ier)
+        endif
+     endif
+
+  endif
+
+  if(associated(sharedIndices%aVindices2)) then
+     
+     deallocate(sharedIndices%aVindices2,stat=ier)
+
+     if (ier /= 0) then
+        if(present(stat)) then
+           stat=ier
+        else
+           call die(myname_,'deallocate(sharedIndices%aVindices2)',ier)
+        endif
+     endif
+
+  endif  
+        
+  ! Reset other components to default values
+  sharedIndices%num_indices = 0
+  sharedIndices%contiguous = .false.
+  sharedIndices%data_flag = ' '
+
+  end subroutine cleanSharedIndicesOneType_
+
+ end module m_AttrVect
+!.
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectComms.F90	(revision 4775)
@@ -0,0 +1,1683 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_AttrVectComms.F90,v 1.39 2009-03-05 16:41:47 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_AttrVectComms - MPI Communications Methods for the AttrVect
+!
+! !DESCRIPTION:
+!
+! This module defines the communications methods for the {\tt AttrVect} 
+! datatype (see the module {\tt m\_AttrVect} for more information about 
+! this class and its methods).  MCT's communications are implemented 
+! in terms of the Message Passing Interface (MPI) standard, and we have 
+! as best as possible, made the interfaces to these routines appear as
+! similar as possible to the corresponding MPI routines.  For the 
+! { \tt AttrVect}, we supply {\em blocking} point-to-point send and 
+! receive operations.  We also supply the following collective 
+! operations: broadcast, gather, and scatter.  The gather and scatter 
+! operations rely on domain decomposition descriptors that are defined
+! elsewhere in MCT:  the {\tt GlobalMap}, which is a one-dimensional 
+! decomposition (see the MCT module {\tt m\_GlobalMap} for more details); 
+! and the {\tt GlobalSegMap}, which is a segmented decomposition capable
+! of supporting multidimensional domain decompositions (see the MCT module 
+! {\tt m\_GlobalSegMap} for more details).
+!
+! !INTERFACE:
+ module m_AttrVectComms
+!
+! !USES:
+!
+      use m_AttrVect ! AttrVect class and its methods
+
+      implicit none
+
+      private	! except
+
+      public :: gather		! gather all local vectors to the root
+      public :: scatter		! scatter from the root to all PEs
+      public :: bcast		! bcast from root to all PEs
+      public :: send		! send an AttrVect
+      public :: recv		! receive an AttrVect
+
+    interface gather ; module procedure &
+	      GM_gather_, &
+	      GSM_gather_ 
+    end interface
+    interface scatter ; module procedure &
+	      GM_scatter_, &
+	      GSM_scatter_ 
+    end interface
+    interface bcast  ; module procedure bcast_  ; end interface
+    interface send  ; module procedure send_  ; end interface
+    interface recv  ; module procedure recv_  ; end interface
+
+! !REVISION HISTORY:
+! 27Oct00 - J.W. Larson <larson@mcs.anl.gov> - relocated routines
+!           from m_AttrVect to create this module.
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - Added APIs for 
+!           GSM_gather_() and GSM_scatter_().
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - Modified GM_scatter_
+!           so its communication model agrees with MPI_scatter().
+!           Also tidied up prologues in all module routines.
+!  7Jun01 - J.W. Larson <larson@mcs.anl.gov> - Added send() 
+!           and recv().
+!  3Aug01 - E.T. Ong <eong@mcs.anl.gov> - in GSM_scatter, call 
+!           GlobalMap_init with actual shaped array to satisfy
+!           Fortran 90 standard. See comment in subroutine.
+! 23Aug01 - E.T. Ong <eong@mcs.anl.gov> - replaced assignment(=)
+!           with copy for list type to avoid compiler bugs in pgf90.
+!           Added more error checking in gsm scatter. Fixed minor bugs 
+!          in gsm and gm gather.
+! 13Dec01 - E.T. Ong <eong@mcs.anl.gov> - GSM_scatter, allow users
+!           to scatter with a haloed GSMap. Fixed some bugs in 
+!           GM_scatter.
+! 19Dec01 - E.T. Ong <eong@mcs.anl.gov> - allow bcast of an AttrVect
+!           with only an integer or real attribute.
+! 27Mar02 - J.W. Larson <larson@mcs.anl.gov> - Corrected usage of
+!           m_die routines throughout this module.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_AttrVectComms'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: send_ - Point-to-point Send of an AttrVect
+!
+! !DESCRIPTION:  This routine takes an input {\tt AttrVect} argument 
+! {\tt inAV} and sends it to processor {\tt dest} on the communicator 
+! associated with the Fortran {\tt INTEGER} MPI communicator handle 
+! {\tt comm}.  The overalll message is tagged by the input {\tt INTEGER} 
+! argument {\tt TagBase}.  The success (failure) of this operation is 
+! reported in the zero (nonzero) optional output argument {\tt status}.
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! between {\tt TagBase} and {\tt TagBase+7}, inclusive.  This is 
+! because {\tt send\_()} performs the send of the {\tt AttrVect} as 
+! a series of eight send operations.
+!
+! !INTERFACE:
+
+ subroutine send_(inAV, dest, TagBase, comm, status)
+!
+! !USES:
+!
+      use m_stdio
+      use m_mpif90
+      use m_die
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_send => send
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),     intent(in)  :: inAV
+      integer,            intent(in)  :: dest
+      integer,            intent(in)  :: TagBase
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional,  intent(out) :: status
+
+! !REVISION HISTORY:
+!  7Jun01 - J.W. Larson - initial version.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!           (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::send_'
+
+ logical :: ListAssoc(2)
+ integer :: ierr
+ integer :: AVlength
+
+      ! Initialize status (if present)
+
+  if(present(status)) status = 0
+
+
+       ! Step 1. Are inAV%iList and inAV%rList filled?  Store
+       ! the answers in the LOGICAL array ListAssoc and send.
+
+  ListAssoc(1) = List_allocated(inAV%iList) 
+  ListAssoc(2) = List_allocated(inAV%rList) 
+
+  if(.NOT. (ListAssoc(1).or.ListAssoc(2)) ) then
+     call die(myname_,"inAV has not been initialized")
+  endif
+     
+  call MPI_SEND(ListAssoc, 2, MP_LOGICAL, dest, TagBase, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_SEND(ListAssoc...',ierr)
+  endif
+
+
+       ! Step 2. Send non-blank inAV%iList and inAV%rList.
+
+  if(ListAssoc(1)) then
+    call List_send(inAV%iList, dest, TagBase+1, comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+	  write(stderr,*) myname_,':: call List_send(inAV%iList...'
+	  status = ierr
+	  return
+       else
+	  call die(myname_,':: call List_send(inAV%iList...',ierr)
+       endif
+    endif
+  endif
+
+  if(ListAssoc(2)) then
+    call List_send(inAV%rList, dest, TagBase+3, comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+	  write(stderr,*) myname_,':: call List_send(inAV%rList...'
+	  status = ierr
+	  return
+       else
+	  call die(myname_,':: call List_send(inAV%rList...',ierr)
+       endif
+    endif
+  endif
+
+       ! Step 3. Determine and send the lengths of inAV%iAttr(:,:)
+       ! and inAV%rAttr(:,:).
+
+  AVlength = AttrVect_lsize(inAV)
+
+  if(AVlength<=0) then
+     call die(myname_,"Size of inAV <= 0",AVLength)
+  endif
+
+  call MPI_SEND(AVlength, 1, MP_type(AVlength), dest, TagBase+5, &
+                comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: call MPI_SEND(AVlength...',ierr)
+  endif
+
+       ! Step 4. If AVlength > 0, we may have INTEGER and REAL 
+       ! data to send.  Send as needed.
+
+  if(AVlength > 0) then
+
+     if(ListAssoc(1)) then
+
+       ! Send the INTEGER data stored in inAV%iAttr(:,:)
+
+	call MPI_SEND(inAV%iAttr(1,1), AVlength*List_nitem(inAV%iList), &
+                      MP_type(inAV%iAttr(1,1)), dest, TagBase+6,   &
+                      comm, ierr)
+	if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_SEND(inAV%iAttr...',ierr)
+	endif
+
+     endif ! if(associated(inAV%rList))
+
+     if(ListAssoc(2)) then
+
+       ! Send the REAL data stored in inAV%rAttr(:,:)
+
+	call MPI_SEND(inAV%rAttr(1,1), AVlength*List_nitem(inAV%rList), &
+                      MP_type(inAV%rAttr(1,1)), dest, TagBase+7,   &
+                      comm, ierr)
+	if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_SEND(inAV%rAttr...',ierr)
+	endif
+
+     endif ! if(associated(inAV%rList))
+
+  endif ! if (AVlength > 0)
+
+ end subroutine send_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: recv_ - Point-to-point Receive of an AttrVect
+!
+! !DESCRIPTION:  This routine receives the output {\tt AttrVect} argument 
+! {\tt outAV} from processor {\tt source} on the communicator associated 
+! with the Fortran {\tt INTEGER} MPI communicator handle {\tt comm}.  The 
+! overall message is tagged by the input {\tt INTEGER} argument 
+! {\tt TagBase}.  The success (failure) of this operation is reported in 
+! the zero (nonzero) optional output argument {\tt status}.
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! between {\tt TagBase} and {\tt TagBase+7}, inclusive.  This is 
+! because {\tt recv\_()} performs the receive of the {\tt AttrVect} as 
+! a series of eight receive operations.
+!
+! !INTERFACE:
+
+ subroutine recv_(outAV, dest, TagBase, comm, status)
+!
+! !USES:
+!
+      use m_stdio
+      use m_mpif90
+      use m_die
+
+      use m_List, only : List
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_recv => recv
+
+      use m_AttrVect, only : AttrVect
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,            intent(in)  :: dest
+      integer,            intent(in)  :: TagBase
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(AttrVect),     intent(out) :: outAV
+      integer, optional,  intent(out) :: status
+
+! !REVISION HISTORY:
+!  7Jun01 - J.W. Larson - initial working version.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!           (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::recv_'
+
+ logical :: ListAssoc(2)
+ integer :: ierr
+ integer :: AVlength
+ integer :: MPstatus(MP_STATUS_SIZE)
+
+      ! Initialize status (if present)
+
+  if(present(status)) status = 0
+
+
+       ! Step 1. Are outAV%iList and outAV%rList filled?  TRUE
+       ! entries in the LOGICAL array ListAssoc(:) correspond
+       ! to Non-blank Lists...that is:
+       !
+       ! ListAssoc(1) = .TRUE. <==> associated(outAV%iList%bf)
+       ! ListAssoc(2) = .TRUE. <==> associated(outAV%rList%bf)
+
+  call MPI_RECV(ListAssoc, 2, MP_LOGICAL, dest, TagBase, comm, &
+                MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_RECV(ListAssoc...',ierr)
+  endif
+
+
+       ! Step 2. Receive non-blank outAV%iList and outAV%rList.
+
+  if(ListAssoc(1)) then
+    call List_recv(outAV%iList, dest, TagBase+1, comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+	  write(stderr,*) myname_,':: call List_recv(outAV%iList...'
+	  status = ierr
+	  return
+       else
+	  call die(myname_,':: call List_recv(outAV%iList...',ierr)
+       endif
+    endif
+  endif
+
+  if(ListAssoc(2)) then
+    call List_recv(outAV%rList, dest, TagBase+3, comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+	  write(stderr,*) myname_,':: call List_recv(outAV%rList...'
+	  status = ierr
+	  return
+       else
+	  call die(myname_,':: call List_recv(outAV%rList...',ierr)
+       endif
+    endif
+  endif
+
+       ! Step 3. Receive the lengths of outAV%iAttr(:,:) and outAV%rAttr(:,:).
+
+  call MPI_RECV(AVlength, 1, MP_type(AVlength), dest, TagBase+5, &
+                comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: call MPI_RECV(AVlength...',ierr)
+  endif
+
+       ! Step 4. If AVlength > 0, we may have to receive INTEGER 
+       ! and/or REAL data.  Receive as needed.
+
+  if(AVlength > 0) then
+
+     if(ListAssoc(1)) then
+
+       ! Allocate outAV%iAttr(:,:)
+
+        allocate(outAV%iAttr(List_nitem(outAV%iList),AVlength), stat=ierr)
+        if(ierr/=0) call die(myname_,"allocate(outAV%iAttr)",ierr)
+
+       ! Receive the INTEGER data to outAV%iAttr(:,:)
+
+	call MPI_RECV(outAV%iAttr(1,1), AVlength*List_nitem(outAV%iList), &
+                      MP_type(outAV%iAttr(1,1)), dest, TagBase+6,   &
+                      comm, MPstatus, ierr)
+	if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_RECV(outAV%iAttr...',ierr)
+	endif
+
+     endif ! if(associated(outAV%rList))
+
+     if(ListAssoc(2)) then
+
+       ! Allocate outAV%rAttr(:,:)
+
+        allocate(outAV%rAttr(List_nitem(outAV%rList),AVlength), stat=ierr)
+        if(ierr/=0) call die(myname_,"allocate(outAV%rAttr)",ierr)
+
+       ! Receive the REAL data to outAV%rAttr(:,:)
+
+	call MPI_RECV(outAV%rAttr(1,1), AVlength*List_nitem(outAV%rList), &
+                      MP_type(outAV%rAttr(1,1)), dest, TagBase+7,   &
+                      comm, MPstatus, ierr)
+	if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_RECV(outAV%rAttr...',ierr)
+	endif
+
+     endif ! if(associated(outAV%rList))
+
+  endif ! if (AVlength > 0)
+
+ end subroutine recv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_gather_ - Gather an AttrVect Distributed by a GlobalMap
+!
+! !DESCRIPTION:
+! This routine gathers a {\em distributed} {\tt AttrVect} {\tt iV} to 
+! the {\tt root} process, and returns it in the output {\tt AttrVect}
+! argument {\tt oV}.  The decomposition of {\tt iV} is described by 
+! the input {\tt GlobalMap} argument {\tt GMap}.  The input {\tt INTEGER}
+! argument {\tt comm} is the Fortran integer MPI communicator handle.
+! The success (failure) of this operation corresponds to a zero (nonzero)
+! value of the optional output {\tt INTEGER} argument {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine GM_gather_(iV, oV, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : FP
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_lsize => lsize
+      use m_GlobalMap, only : GlobalMap_gsize => gsize
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero 
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_FcComms,  only : fc_gatherv_int, fc_gatherv_fp
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),           intent(in)  :: iV
+      type(GlobalMap),          intent(in)  :: GMap
+      integer,                  intent(in)  :: root
+      integer,                  intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),           intent(out) :: oV
+      integer,        optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+! 15Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 27Oct00 - J.W. Larson <larson@mcs.anl.gov> - relocated from
+!           m_AttrVect
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - renamed GM_gather_
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - tidied up prologue
+! 18May01 - R.L. Jacob <jacob@mcs.anl.gov> - use MP_Type function
+!           to determine type for mpi_gatherv
+! 31Jan09 - P.H. Worley <worleyph@ornl.gov> - replaced call to
+!           MPI_gatherv with call to flow controlled gather routines
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GM_gather_'
+  integer :: nIA,nRA,niV,noV,ier
+  integer :: myID
+  integer :: mp_type_Av
+  type(AttrVect) :: nonRootAV
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm, myID, ier)
+  if(ier /= 0) then
+     call MP_perr_die(myname_,':: call MP_COMM_RANK()',ier)
+  endif
+
+	! Verify the input: a _scatterd_ vector
+
+  niV=GlobalMap_lsize(GMap)
+  noV=AttrVect_lsize(iV)
+
+  if(niV /= noV) then
+     write(stderr,'(2a,i4,a,i4,a,i4)') myname_,	&
+	  ': invalid input, lsize(GMap) =',niV,	&
+	  ', lsize(iV) =',noV, 'myID =', myID
+     if(.not.present(stat)) call die(myname_)
+     stat=-1
+     return
+  endif
+
+  noV=GlobalMap_gsize(GMap) ! the gathered local size, as for the output
+
+  if(myID == root) then
+     call AttrVect_init(oV,iV,noV)
+     call AttrVect_zero(oV)
+  else
+     call AttrVect_init(nonRootAV,iV,1)
+     call AttrVect_zero(nonRootAV)
+  endif
+
+  niV=GlobalMap_lsize(GMap) ! the scattered local size, as for the input
+
+  nIA=AttrVect_nIAttr(iV)	! number of INTEGER attributes
+  nRA=AttrVect_nRAttr(iV)	! number of REAL attributes
+
+  mp_type_Av = MP_Type(1._FP)   ! set mpi type to same as AV%rAttr
+
+  if(nIA > 0) then
+     
+     if(myID == root) then
+
+        call fc_gatherv_int(iV%iAttr,niV*nIA,MP_INTEGER,		&
+             oV%iAttr,GMap%counts*nIA,GMap%displs*nIA,             &
+             MP_INTEGER,root,comm)
+
+     else
+        
+        call fc_gatherv_int(iV%iAttr,niV*nIA,MP_INTEGER,		&
+             nonRootAV%iAttr,GMap%counts*nIA,GMap%displs*nIA,      &
+             MP_INTEGER,root,comm)
+
+     endif  ! if(myID == root)
+        
+  endif  ! if(nIA > 0)
+
+  if(nRA > 0) then
+
+     if(myID == root) then
+
+        call fc_gatherv_fp(iV%rAttr,niV*nRA,mp_type_Av,	        &
+             oV%rAttr,GMap%counts*nRA,GMap%displs*nRA,             & 
+             mp_type_Av,root,comm)
+
+     else
+
+        call fc_gatherv_fp(iV%rAttr,niV*nRA,mp_type_Av,	        &
+             nonRootAV%rAttr,GMap%counts*nRA,GMap%displs*nRA,      &
+             mp_type_Av,root,comm)
+
+     endif  ! if(myID == root)
+
+  endif  ! if(nRA > 0)
+
+
+
+  if(myID /= root) then
+     call AttrVect_clean(nonRootAV,ier)
+     if(ier /= 0) then
+        write(stderr,'(2a,i4)') myname_,	&
+             ':: AttrVect_clean(nonRootAV) failed for non-root &
+             &process: myID = ', myID
+        call die(myname_,':: AttrVect_clean failed &
+             &for nonRootAV off of root',ier)
+     endif
+  endif
+
+ end subroutine GM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_gather_ - Gather an AttrVect Distributed by a GlobalSegMap
+!
+! !DESCRIPTION:
+! The routine {\tt GSM\_gather\_()} takes a distributed input 
+! {\tt AttrVect} argument {\tt iV}, whose decomposition is described 
+! by the input {\tt GlobalSegMap} argument {\tt GSMap}, and gathers 
+! it to the output {\tt AttrVect} argument {\tt oV}.  The gathered 
+! {\tt AttrVect} {\tt oV} is valid only on the root process specified 
+! by the input argument {\tt root}.  The communicator used to gather
+! the data is specified by the argument {\tt comm}.  The success (failure)
+! is reported in the zero (non-zero) value of the output argument 
+! {\tt stat}.
+!
+! {\tt GSM\_gather\_()} converts the problem of gathering data 
+! according to a {\tt GlobalSegMap} into the simpler problem of 
+! gathering data as specified by a {\tt GlobalMap}.  The {\tt GlobalMap}
+! variable {\tt GMap} is created based on the local storage requirements 
+! for each distributed piece of {\tt iV}.  On the root, a complete 
+! (including halo points) gathered copy of {\tt iV} is collected into 
+! the temporary {\tt AttrVect} variable {\tt workV} (the length of
+! {\tt workV} is the larger of {\tt GlobalSegMap\_GlobalStorage(GSMap)} or
+! {\tt GlobalSegMap\_GlobalSize(GSMap)}).  The 
+! variable {\tt workV} is segmented by process, and segments are 
+! copied into it by process, but ordered in the same order the segments
+! appear in {\tt GSMap}.  Once {\tt workV} is loaded, the data are 
+! copied segment-by-segment to their appropriate locations in the output 
+! {\tt AttrVect} {\tt oV}.
+!
+! !INTERFACE:
+
+ subroutine GSM_gather_(iV, oV, GSMap, root, comm, stat, rdefault, idefault)
+!
+! !USES:
+!
+! Message-passing environment utilities (mpeu) modules:
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only: FP
+! GlobalSegMap and associated services:
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_id
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_haloed => haloed
+      use m_GlobalSegMap, only : GlobalSegMap_GlobalStorage => GlobalStorage
+! AttrVect and associated services:
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_clean => clean 
+! GlobalMap and associated services:
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_init => init
+      use m_GlobalMap, only : GlobalMap_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),            intent(in)  :: iV
+      type(GlobalSegMap),        intent(in)  :: GSMap
+      integer,                   intent(in)  :: root
+      integer,                   intent(in)  :: comm
+      real(FP), optional,        intent(in)  :: rdefault
+      integer, optional,         intent(in)  :: idefault
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),            intent(out) :: oV
+      integer,        optional,  intent(out) :: stat
+
+! !REVISION HISTORY:
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - J.W. Larson <larson@mcs.anl.gov> - Prototype code.
+! 26Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add use statement for
+!           AttVect_clean
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - tidied up prologue
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!           (if present).
+! 20Aug01 - E.T. Ong <eong@mcs.anl.gov> - Added error checking for
+!           matching processors in gsmap and comm. Corrected
+!           current_pos assignment.
+! 23Nov01 - R. Jacob <jacob@mcs.anl.gov> - zero the oV before copying in
+!           gathered data.
+! 27Jul07 - R. Loy <rloy@mcs.anl.gov> - add Tony's suggested improvement
+!           for a default value in the output AV
+! 11Aug08 - R. Jacob <jacob@mcs.anl.gov> - add Pat Worley's faster way
+!           to initialize lns
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GSM_gather_'
+
+! Temporary workspace AttrVect:
+  type(AttrVect) :: workV
+! Component ID and number of segments for GSMap:
+  integer :: comp_id, ngseg, iseg
+! Total length of GSMap segments laid end-to-end:
+  integer :: global_storage
+! Error Flag
+  integer :: ierr
+! Number of processes on communicator, and local rank:
+  integer :: NumProcs, myID
+! Total local storage on each pe according to GSMap:
+  integer, dimension(:), allocatable :: lns
+! Temporary GlobalMap used to scatter the segmented (by pe) data
+  type(GlobalMap) :: workGMap
+! Loop counters and temporary indices:
+  integer :: m, n, ilb, iub, olb, oub, pe
+! workV segment tracking index array:
+  integer, dimension(:), allocatable :: current_pos
+! workV sizes
+  integer :: gssize, gstorage
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Initial Check:  If GSMap contains halo points, die
+       
+  if(GlobalSegMap_haloed(GSMap)) then
+     ierr = 1
+     call die(myname_,"Input GlobalSegMap haloed--not allowed",ierr)
+  endif
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+
+  if(ierr /= 0) then
+	call MP_perr_die(myname_,':: call MPI_COMM_RANK()',ierr)
+  endif
+       ! How many processes are there on this communicator?
+
+  call MPI_COMM_SIZE(comm, NumProcs, ierr)
+
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: call MPI_COMM_SIZE()',ierr)
+  endif
+
+       ! Processor Check: Do the processors on GSMap match those in comm?
+
+  if(MAXVAL(GSMap%pe_loc) > (NumProcs-1)) then
+     stat=2
+     write(stderr,*) myname_, &
+       ":: Procs in GSMap%pe_loc do not match procs in communicator ", &
+       NumProcs-1, MAXVAL(GSMap%pe_loc)
+     call die(myname_, &
+	  "Procs in GSMap%pe_loc do not match procs in communicator",stat)
+  endif
+
+  if(myID == root) then
+
+       ! Allocate a precursor to a GlobalMap accordingly...
+
+     allocate(lns(0:NumProcs-1), stat=ierr)
+
+       ! And Load it...
+
+     lns(:)=0
+     do iseg=1,GSMap%ngseg
+        n = GSMap%pe_loc(iseg)
+	lns(n) = lns(n) + GSMap%length(iseg)
+     end do
+
+  else
+
+     allocate(lns(0)) ! This conforms to F90 standard for shaped arguments.
+
+  endif ! if(myID == root)
+
+       ! Determine the component id of GSMap:
+
+  comp_id = GlobalSegMap_comp_id(GSMap)
+
+       ! Create working GlobalMap workGMap (used for the gather):
+
+  call GlobalMap_init(workGMap, comp_id, lns, root, comm)
+
+       ! Gather the Data process-by-process to workV...
+       ! do not include stat argument; bypass an argument check in gm_gather.
+
+  call GM_gather_(iV, workV, workGMap, root, comm, stat)
+
+       ! On the root, initialize oV, and load the contents of
+       !workV into it...
+
+  if(myID == root) then
+
+! bug fix:  gstorage will be bigger than gssize if GSmap is
+! haloed.  But gstorage may be smaller than gsize if GSmap
+! is masked.  So take the maximum.  RLJ
+     gstorage = GlobalSegMap_GlobalStorage(GSMap)
+     gssize = GlobalSegMap_gsize(GSMap)
+     global_storage = MAX(gstorage,gssize)
+
+     call AttrVect_init(oV,iV,global_storage)
+     call AttrVect_zero(oV)
+
+     if (present(rdefault)) then
+       if (AttrVect_nRAttr(oV) > 0) oV%rAttr=rdefault
+     endif
+     if (present(idefault)) then
+       if (AttrVect_nIAttr(oV) > 0) oV%iAttr=idefault
+     endif
+
+       ! On the root, allocate current position index for
+       ! each process chunk:
+
+     allocate(current_pos(0:NumProcs-1), stat=ierr)
+
+     if(ierr /= 0) then
+	write(stderr,*) myname_,':: allocate(current_pos(..) failed,', &
+	     'stat = ',ierr
+	if(present(stat)) then
+	   stat=ierr
+	else
+	   call die(myname_,'allocate(current_pos(..) failed.' )
+	endif
+     endif
+
+       ! Initialize current_pos(:) using GMap%displs(:)
+
+     do n=0,NumProcs-1
+	current_pos(n) = workGMap%displs(n) + 1
+     end do
+
+       ! Load each segment of iV into its appropriate segment
+       ! of workV:
+     
+     ngseg = GlobalSegMap_ngseg(GSMap)
+
+     do n=1,ngseg
+
+       ! Determine which process owns segment n:
+
+	pe = GSMap%pe_loc(n)
+
+       ! Input map (lower/upper indicess) of segment of iV:
+
+	ilb = current_pos(pe)
+	iub = current_pos(pe) + GSMap%length(n) - 1
+
+       ! Output map of (lower/upper indicess) segment of workV:
+
+	olb = GSMap%start(n)
+	oub = GSMap%start(n) + GSMap%length(n) - 1
+
+       ! Increment current_pos(n) for next time:
+
+	current_pos(pe) = current_pos(pe) + GSMap%length(n)
+
+       ! Now we are equipped to do the copy:
+
+	do m=1,AttrVect_nIAttr(iV)
+   	   oV%iAttr(m,olb:oub) = workV%iAttr(m,ilb:iub)
+	end do
+
+	do m=1,AttrVect_nRAttr(iV)
+   	   oV%rAttr(m,olb:oub) = workV%rAttr(m,ilb:iub)
+	end do
+
+     end do ! do n=1,ngseg
+
+       ! Clean up current_pos, which was only allocated on the root
+
+     deallocate(current_pos, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,*) myname_,'error in deallocate(current_pos), stat=',ierr
+	if(present(stat)) then
+	   stat=ierr
+	else
+	   call die(myname_)
+	endif
+     endif
+  endif ! if(myID == root)
+
+       ! At this point, we are finished.  The data have been gathered
+       ! to oV
+
+       ! Finally, clean up allocated structures:
+
+  if(myID == root) call AttrVect_clean(workV)
+  call GlobalMap_clean(workGMap)
+
+  deallocate(lns, stat=ierr)
+
+  if(ierr /= 0) then
+    write(stderr,*) myname_,'error in deallocate(lns), stat=',ierr
+    if(present(stat)) then
+       stat=ierr
+    else
+       call die(myname_)
+    endif
+  endif
+
+ end subroutine GSM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_scatter_ - Scatter an AttrVect Using a GlobalMap
+!
+! !DESCRIPTION:
+! The routine {\tt GM\_scatter\_} takes an input {\tt AttrVect} type
+! {\tt iV} (valid only on the root), and scatters it to a distributed 
+! {\tt AttrVect} {\tt oV}.  The input {\tt GlobalMap} argument 
+! {\tt GMap} dictates how {\tt iV} is scattered to {\tt oV}.  The 
+! success (failure) of this routine is reported in the zero (non-zero)
+! value of the output argument {\tt stat}.
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt oV} represents
+! dynamically allocated memory.  When it is no longer needed, it should
+! be deallocated by invoking {\tt AttrVect\_clean()} (see the module
+! {\tt m\_AttrVect} for more details).
+!
+! !INTERFACE:
+
+ subroutine GM_scatter_(iV, oV, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : FP
+
+      use m_List, only : List
+      use m_List, only : List_copy => copy
+      use m_List, only : List_bcast => bcast
+      use m_List, only : List_clean => clean
+      use m_List, only : List_nullify => nullify
+      use m_List, only : List_nitem => nitem
+
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_lsize => lsize
+      use m_GlobalMap, only : GlobalMap_gsize => gsize
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),           intent(in)  :: iV
+      type(GlobalMap),          intent(in)  :: GMap
+      integer,                  intent(in)  :: root
+      integer,                  intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),           intent(out) :: oV
+      integer,        optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 27Oct00 - J.W. Larson <larson@mcs.anl.gov> - relocated from
+!           m_AttrVect
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - renamed  GM_scatter_
+!  8Feb01 - J.W. Larson <larson@mcs.anl.gov> - add logic to prevent
+!           empty calls (i.e. no data in buffer) to MPI_SCATTERV()
+! 27Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - small bug fix to
+!           integer attribute scatter
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - Re-vamped comms model
+!           to reflect MPI comms model for the scatter.  Tidied up
+!           the prologue, too.
+! 18May01 - R.L. Jacob <jacob@mcs.anl.gov> - use MP_Type function
+!           to determine type for mpi_scatterv
+!  8Aug01 - E.T. Ong <eong@mcs.anl.gov> - replace list assignment(=)
+!           with list copy to avoid compiler errors in pgf90.
+! 13Dec01 - E.T. Ong <eong@mcs.anl.gov> - allow scatter with an
+!           AttrVect containing only an iList or rList.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GM_scatter_'
+  integer :: nIA,nRA,niV,noV,ier
+  integer :: myID
+  integer :: mp_type_Av
+  type(List) :: iList, rList
+  type(AttrVect) :: nonRootAV
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) then
+    call MP_perr_die(myname_,'MP_comm_rank()',ier)
+  endif
+
+	! Verify the input: a _gathered_ vector
+
+  if(myID == root) then
+
+     niV = GlobalMap_gsize(GMap)  ! the _gathered_ local size
+     noV = AttrVect_lsize(iV)     ! the length of the input AttrVect iV
+
+     if(niV /= noV) then
+        write(stderr,'(2a,i5,a,i8,a,i8)') myname_,	&
+             ': myID = ',myID,'.  Invalid input on root, gsize(GMap) =',&
+             niV,', lsize(iV) =',noV
+        if(present(stat)) then
+           stat=-1
+        else
+           call die(myname_)
+        endif
+     endif
+
+  endif
+
+        ! On the root, read the integer and real attribute 
+        ! lists off of iV.
+
+  call List_nullify(iList)
+  call List_nullify(rList)
+
+  if(myID == root) then
+
+     ! Count the number of real and integer attributes
+
+     nIA = AttrVect_nIAttr(iV)	! number of INTEGER attributes
+     nRA = AttrVect_nRAttr(iV)	! number of REAL attributes
+
+     if(nIA > 0) then
+	call List_copy(iList,iV%iList)
+     endif
+
+     if(nRA > 0) then
+	call List_copy(rList,iV%rList)
+     endif
+
+  endif
+  
+        ! From the root, broadcast iList and rList
+
+  call MPI_BCAST(nIA,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) call MP_perr(myname_,'MPI_BCAST(nIA)',ier)
+
+  call MPI_BCAST(nRA,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) call MP_perr(myname_,'MPI_BCAST(nRA)',ier)
+
+  if(nIA>0) call List_bcast(iList, root, comm)
+  if(nRA>0) call List_bcast(rList, root, comm)
+
+  noV = GlobalMap_lsize(GMap) ! the _scatterd_ local size
+
+        ! On all processes, use List data and noV to initialize oV 
+
+  call AttrVect_init(oV, iList, rList, noV)
+  call AttrVect_zero(oV)
+
+        ! Initialize a dummy AttrVect for non-root MPI calls
+
+  if(myID/=root) then
+    call AttrVect_init(nonRootAV,oV,1)
+    call AttrVect_zero(nonRootAV)
+  endif
+
+
+  if(nIA > 0) then
+
+     if(myID == root) then
+
+        call MPI_scatterv(iV%iAttr(1,1),GMap%counts*nIA,	&
+             GMap%displs*nIA,MP_INTEGER,oV%iAttr(1,1),          &
+             noV*nIA,MP_INTEGER,root,comm,ier )
+        if(ier /= 0) then
+           call MP_perr_die(myname_,'MPI_scatterv(iAttr) on root',ier)
+        endif
+
+     else
+
+        call MPI_scatterv(nonRootAV%iAttr(1,1),GMap%counts*nIA,	&
+             GMap%displs*nIA,MP_INTEGER,oV%iAttr(1,1),          &
+             noV*nIA,MP_INTEGER,root,comm,ier )
+        if(ier /= 0) then
+           call MP_perr_die(myname_,'MPI_scatterv(iAttr) off root',ier)
+        endif
+
+     endif   ! if(myID == root)
+
+     call List_clean(iList)
+
+  endif   ! if(nIA > 0)
+
+  mp_type_Av = MP_Type(1._FP)   ! set mpi type to same as AV%rAttr
+
+  if(nRA > 0) then
+
+     if(myID == root) then
+
+
+        call MPI_scatterv(iV%rAttr(1,1),GMap%counts*nRA,	&
+             GMap%displs*nRA,mp_type_Av,oV%rAttr(1,1),          &
+             noV*nRA,mp_type_Av,root,comm,ier )
+        if(ier /= 0) then
+           call MP_perr_die(myname_,'MPI_scatterv(rAttr) on root',ier)
+        endif
+
+     else
+
+
+        call MPI_scatterv(nonRootAV%rAttr,GMap%counts*nRA,	&
+             GMap%displs*nRA,mp_type_Av,oV%rAttr,          &
+             noV*nRA,mp_type_Av,root,comm,ier )
+        if(ier /= 0) then
+           call MP_perr_die(myname_,'MPI_scatterv(rAttr) off root',ier)
+        endif
+
+     endif
+
+     call List_clean(rList)
+
+  endif
+
+  if(myID /= root) then
+     call AttrVect_clean(nonRootAV,ier)
+     if(ier /= 0) then
+        write(stderr,'(2a,i4)') myname_,	&
+             ':: AttrVect_clean(nonRootAV) failed for non-root &
+             &process: myID = ', myID
+        call die(myname_,':: AttrVect_clean failed &
+             &for nonRootAV off of root',ier)
+     endif
+  endif
+
+ end subroutine GM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_scatter_ - Scatter an AttrVect using a GlobalSegMap
+!
+! !DESCRIPTION:
+! The routine {\tt GSM\_scatter\_} takes an input {\tt AttrVect} type
+! {\tt iV} (valid only on the root), and scatters it to a distributed 
+! {\tt AttrVect} {\tt oV}.  The input {\tt GlobalSegMap} argument 
+! {\tt GSMap} dictates how {\tt iV} is scattered to {\tt oV}.  The 
+! success (failure) of this routine is reported in the zero (non-zero)
+! value of the output argument {\tt stat}.
+!
+! {\tt GSM\_scatter\_()} converts the problem of scattering data 
+! according to a {\tt GlobalSegMap} into the simpler problem of 
+! scattering data as specified by a {\tt GlobalMap}.  The {\tt GlobalMap}
+! variable {\tt GMap} is created based on the local storage requirements 
+! for each distributed piece of {\tt iV}.  On the root, a complete 
+! (including halo points) copy of {\tt iV} is stored in 
+! the temporary {\tt AttrVect} variable {\tt workV} (the length of
+! {\tt workV} is {\tt GlobalSegMap\_GlobalStorage(GSMap)}).  The 
+! variable {\tt workV} is segmented by process, and segments are 
+! copied into it by process, but ordered in the same order the segments
+! appear in {\tt GSMap}.  Once {\tt workV} is loaded, the data are 
+! scattered to the output {\tt AttrVect} {\tt oV} by a call to the
+! routine {\tt GM\_scatter\_()} defined in this module, with {\tt workV}
+! and {\tt GMap} as the input arguments.
+!
+! {\bf N.B.:}  This algorithm  assumes that memory access times are much 
+! shorter than message-passing transmission times.
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt oV} represents
+! dynamically allocated memory.  When it is no longer needed, it should
+! be deallocated by invoking {\tt AttrVect\_clean()} (see the module
+! {\tt m\_AttrVect} for more details).
+!
+! !INTERFACE:
+
+ subroutine GSM_scatter_(iV, oV, GSMap, root, comm, stat)
+!
+! !USES:
+!
+! Environment utilities from mpeu:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_List, only : List_nullify => nullify
+
+! GlobalSegMap and associated services:
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_id
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_GlobalStorage => GlobalStorage
+! AttrVect and associated services:
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect,  only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_clean => clean 
+! GlobalMap and associated services:
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_init => init
+      use m_GlobalMap, only : GlobalMap_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(AttrVect),            intent(in)  :: iV
+      type(GlobalSegMap),        intent(in)  :: GSMap
+      integer,                   intent(in)  :: root
+      integer,                   intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),            intent(out) :: oV
+      integer,        optional,  intent(out) :: stat
+
+! !REVISION HISTORY:
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+!  8Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+! 25Feb01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix--replaced
+!           call to GlobalSegMap_lsize with call to the new fcn.
+!           GlobalSegMap_ProcessStorage().
+! 26Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add use statement for
+!           AttVect_clean
+! 26Apr01 - J.W. Larson <larson@mcs.anl.gov> - bug fixes--data 
+!           misalignment in use of the GlobalMap to compute the
+!           memory map into workV, and initialization of workV
+!           on all processes.
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - tidied up prologue
+! 15May01 - Larson / Jacob <larson@mcs.anl.gov> - stopped initializing
+!           workV on off-root processes (no longer necessary).
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!           (if present).
+! 20Jun01 - J.W. Larson <larson@mcs.anl.gov> - Fixed a subtle bug
+!           appearing on AIX regarding the fact workV is uninitial-
+!           ized on non-root processes.  This is fixed by nullifying
+!           all the pointers in workV for non-root processes.
+! 20Aug01 - E.T. Ong <eong@mcs.anl.gov> - Added argument check
+!           for matching processors in gsmap and comm.
+! 13Dec01 - E.T. Ong <eong@mcs.anl.gov> - got rid of restriction 
+!           GlobalStorage(GSMap)==AttrVect_lsize(AV) to allow for
+!           GSMap to be haloed.
+! 11Aug08 - R. Jacob <jacob@mcs.anl.gov> - remove call to ProcessStorage
+!           and replace with faster algorithm provided by Pat Worley
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GSM_scatter_'
+
+! Temporary workspace AttrVect:
+  type(AttrVect) :: workV
+! Component ID and number of segments for GSMap:
+  integer :: comp_id, ngseg, iseg
+! Total length of GSMap segments laid end-to-end:
+  integer :: global_storage
+! Error Flag
+  integer :: ierr
+! Number of processes on communicator, and local rank:
+  integer :: NumProcs, myID
+! Total local storage on each pe according to GSMap:
+  integer, dimension(:), allocatable :: lns
+! Temporary GlobalMap used to scatter the segmented (by pe) data
+  type(GlobalMap) :: GMap
+! Loop counters and temporary indices:
+  integer :: m, n, ilb, iub, olb, oub, pe
+! workV segment tracking index array:
+  integer, dimension(:), allocatable :: current_pos
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK',ierr)
+  endif
+
+  if(myID == root) then
+     
+     if(GSMap%gsize > AttrVect_lsize(iV)) then
+	write(stderr,'(2a,i5,a,i8,a,i8)') myname_,	&
+	     ': myID = ',myID,'.  Invalid input, GSMap%gsize =',&
+	     GSMap%gsize, ', lsize(iV) =',AttrVect_lsize(iV)
+	if(present(stat)) then
+	   stat=-1
+	else
+	   call die(myname_)
+	endif
+     endif
+
+  endif     
+
+       ! On the root, initialize a work AttrVect type of the 
+       ! above length, and with the same attribute lists as iV.
+       ! on other processes, initialize workV only with the 
+       ! attribute information, but no storage.
+
+  if(myID == root) then
+
+     global_storage = GlobalSegMap_GlobalStorage(GSMap)
+     call AttrVect_init(workV, iV, global_storage)
+     call AttrVect_zero(workV)
+
+  else
+       ! nullify workV just to be safe
+ 
+     call List_nullify(workV%iList)
+     call List_nullify(workV%rList)
+     nullify(workV%iAttr)
+     nullify(workV%rAttr)
+
+  endif
+
+       ! Return to processing on the root to load workV:
+
+       ! How many processes are there on this communicator?
+
+  call MPI_COMM_SIZE(comm, NumProcs, ierr)
+
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_SIZE',ierr)
+  endif
+
+       ! Processor Check: Do the processors on GSMap match those in comm?
+
+  if(MAXVAL(GSMap%pe_loc) > (NumProcs-1)) then
+     write(stderr,*) myname_, &
+          ":: Procs in GSMap%pe_loc do not match procs in communicator ", &
+          NumProcs-1, MAXVAL(GSMap%pe_loc)
+     if(present(stat)) then
+	stat=1
+	return
+     else
+	call die(myname_)
+     endif
+  endif
+
+  if(myID == root) then
+
+       ! Allocate a precursor to a GlobalMap accordingly...
+
+     allocate(lns(0:NumProcs-1), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,*) myname_,':: allocate(lns...) failed, stat=',ierr
+	if(present(stat)) then
+	   stat=ierr
+	else
+	   call die(myname_,'allocate(lns)',ierr)
+	endif
+     endif
+
+       ! And Load it...
+
+     lns(:)=0
+     do iseg=1,GSMap%ngseg
+        n = GSMap%pe_loc(iseg)
+	lns(n) = lns(n) + GSMap%length(iseg)
+     end do
+
+  endif ! if(myID == root)
+
+        ! Non-root processes call GlobalMap_init with lns,
+        ! although this argument is not used in the 
+        ! subroutine. Since it correspond to a dummy shaped array arguments
+        ! in GlobslMap_init, the Fortran 90 standard dictates that the actual 
+        ! argument must contain complete shape information. Therefore, 
+        ! the array argument must be allocated on all processes.
+
+  if(myID /= root) then
+
+     allocate(lns(1),stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,*) myname_,':: allocate(lns...) failed, stat=',ierr
+	if(present(stat)) then
+	   stat=ierr
+	   return
+	else
+	   call die(myname_,'allocate(lns(1))',ierr)
+	endif
+     endif
+
+  endif ! if(myID /= root)...
+
+       ! Create a GlobalMap describing the 1-D decomposition 
+       ! of workV:
+
+  comp_id = GlobalSegMap_comp_id(GSMap)
+
+  call GlobalMap_init(GMap, comp_id, lns, root, comm)
+
+       ! On the root, load workV:
+
+  if(myID == root) then
+
+       ! On the root, allocate current position index for
+       ! each process chunk:
+
+     allocate(current_pos(0:NumProcs-1), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,*) myname_,':: allocate(current_pos..) failed, stat=', &
+	     ierr
+	if(present(stat)) then
+	   stat=ierr
+	   return
+	else
+	   call die(myname_,'allocate(current_pos)',ierr)
+	endif
+     endif
+
+       ! Initialize current_pos(:) using GMap%displs(:)
+
+     do n=0,NumProcs-1
+	current_pos(n) = GMap%displs(n) + 1
+     end do
+
+       ! Load each segment of iV into its appropriate segment
+       ! of workV:
+
+     ngseg = GlobalSegMap_ngseg(GSMap)
+
+     do n=1,ngseg
+
+       ! Determine which process owns segment n:
+
+	pe = GSMap%pe_loc(n)
+
+       ! Input map (lower/upper indicess) of segment of iV:
+
+	ilb = GSMap%start(n)
+	iub = GSMap%start(n) + GSMap%length(n) - 1
+
+       ! Output map of (lower/upper indicess) segment of workV:
+
+	olb = current_pos(pe)
+	oub = current_pos(pe) + GSMap%length(n) - 1
+
+       ! Increment current_pos(n) for next time:
+
+	current_pos(pe) = current_pos(pe) + GSMap%length(n)
+
+       ! Now we are equipped to do the copy:
+
+	do m=1,AttrVect_nIAttr(iV)
+   	   workV%iAttr(m,olb:oub) = iV%iAttr(m,ilb:iub)
+	end do
+
+	do m=1,AttrVect_nRAttr(iV)
+   	   workV%rAttr(m,olb:oub) = iV%rAttr(m,ilb:iub)
+	end do
+
+     end do ! do n=1,ngseg
+
+       ! Clean up current_pos, which was only allocated on the root
+
+     deallocate(current_pos, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,*) myname_,':: deallocate(current_pos) failed.  ', &
+	     'stat = ',ierr
+	if(present(stat)) then
+	   stat=ierr
+	   return
+	else
+	   call die(myname_,'deallocate(current_pos)',ierr)
+	endif
+     endif
+
+  endif ! if(myID == root)
+
+       ! Now we are in business...we have:  1) an AttrVect laid out
+       ! in contiguous segments, each segment corresponding to a 
+       ! process, and in the same order dictated by GSMap; 
+       ! 2) a GlobalMap telling us which segment of workV goes to 
+       ! which process.  Thus, we can us GM_scatter_() to achieve 
+       ! our goal.
+
+  call GM_scatter_(workV, oV, GMap, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname,':: ERROR in return from GM_scatter_(), ierr=',&
+	  ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_,'ERROR returning from GM_scatter_()',ierr)
+     endif
+  endif
+
+       ! Finally, clean up allocated structures:
+  
+  if(myID == root) then
+     call AttrVect_clean(workV)
+  endif
+
+  call GlobalMap_clean(GMap)
+
+  deallocate(lns, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: ERROR in deallocate(lns), ierr=',ierr
+     if(present(stat)) then
+	stat=ierr
+	return
+     else
+	call die(myname_,'deallocate(lns)',ierr)
+     endif
+  endif
+
+ end subroutine GSM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - Broadcast an AttrVect
+!
+! !DESCRIPTION:  This routine takes an {\tt AttrVect} argument {\tt aV}
+! (at input, valid on the root only), and broadcasts it to all the
+! processes associated with the communicator handle {\tt comm}.  The 
+! success (failure) of this routine is reported in the zero (non-zero)
+! value of the output argument {\tt stat}.
+!
+! {\bf N.B.}:  The output (on non-root processes) {\tt AttrVect} argument 
+! {\tt aV} represents dynamically allocated memory.  When it is no longer 
+! needed, it should be deallocated by invoking {\tt AttrVect\_clean()} 
+! (see the module {\tt m\_AttrVect} for details).
+!
+! !INTERFACE:
+
+ subroutine bcast_(aV, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_String, only : String,bcast,char,String_clean
+      use m_String, only : String_bcast => bcast
+      use m_List, only : List_get => get
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,                  intent(in)    :: root
+      integer,                  intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(AttrVect),           intent(inout) :: aV ! (IN) on the root, 
+                                                    ! (OUT) elsewhere
+
+! !OUTPUT PARAMETERS:
+!
+      integer,        optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 27Apr98 - Jing Guo <guo@thunder> - initial prototype/prologue/code
+! 27Oct00 - J.W. Larson <larson@mcs.anl.gov> - relocated from
+!           m_AttrVect
+!  9May01 - J.W. Larson <larson@mcs.anl.gov> - tidied up prologue
+! 18May01 - R.L. Jacob <jacob@mcs.anl.gov> - use MP_Type function
+!           to determine type for bcast
+! 19Dec01 - E.T. Ong <eong@mcs.anl.gov> - adjusted for case of AV with 
+!           only integer or real attribute 
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcast_'
+  type(String) :: iLStr,rLStr
+  integer :: nIA, nRA, lsize
+  integer :: myID
+  integer :: ier
+  integer :: mp_Type_aV
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) then
+    call MP_perr_die(myname_,'MP_comm_rank()',ier)
+  endif
+
+       ! Broadcaast to all PEs
+
+  if(myID == root) then
+     nIA = AttrVect_nIAttr(aV)
+     nRA = AttrVect_nRAttr(aV)
+     lsize = AttrVect_lsize(aV)
+  endif
+
+  call MPI_bcast(nIA,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) then
+    call MP_perr_die(myname_,'MPI_bcast(nIA)',ier)
+  endif
+
+  call MPI_bcast(nRA,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) then
+    call MP_perr_die(myname_,'MPI_bcast(nRA)',ier)
+  endif
+
+  call MPI_bcast(lsize,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) then
+    call MP_perr_die(myname_,'MPI_bcast(lsize)',ier)
+  endif
+
+	! Convert the two Lists to two Strings 
+
+  if(nIA>0) then
+
+     if(myID == root) call List_get(iLStr,aV%iList)
+
+     call String_bcast(iLStr,root,comm,stat=ier)	! bcast.String()
+
+     if(ier /= 0) then
+	write(stderr,*) myname_,'bcast.String(iLstr), ier=',ier
+	if(present(stat)) then
+	   stat=ier
+	   return
+	else
+	   call die(myname_,'String_bcast(iLStr) failed',ier)
+	endif
+     endif ! if(ier /= 0)...
+
+  endif ! if(nIA > 0)...
+
+
+  if(nRA>0) then
+
+     if(myID == root) call List_get(rLStr,aV%rList)
+
+     call String_bcast(rLStr,root,comm,stat=ier)	! bcast.String()
+     if(ier /= 0) then
+	write(stderr,*) myname_,'bcast.String(iLstr), ier=',ier
+	if(present(stat)) then
+	   stat=ier
+	   return
+	else
+	   call die(myname_,'String_bcast(iLStr) failed',ier)
+	endif
+     endif ! if(ier /= 0)...
+
+  endif ! if(nRA > 0)...
+
+  if(myID /= root) then
+     
+     if( (nIA>0) .and. (nRA>0) ) then
+	call AttrVect_init(aV,iList=char(iLStr),rList=char(rLStr), &
+	                   lsize=lsize)
+     endif
+
+     if( (nIA>0) .and. (nRA<=0) ) then
+	call AttrVect_init(aV,iList=char(iLStr),lsize=lsize)
+     endif
+
+     if( (nIA<=0) .and. (nRA>0) ) then
+	call AttrVect_init(aV,rList=char(rLStr),lsize=lsize)
+     endif
+
+     if( (nIA<=0) .and. (nRA<=0) ) then
+	write(stderr,*) myname_,':: Nonpositive numbers of both ',&
+	     'real AND integer attributes.  nIA =',nIA,' nRA=',nRA
+	if(present(stat)) then
+	   stat = -1
+	   return
+	else
+	   call die(myname_,'AV has not been initialized',-1)
+	endif
+     endif ! if((nIA<= 0) .and. (nRA<=0))...
+
+     call AttrVect_zero(aV)
+
+
+  endif ! if(myID /= root)...
+
+  if(nIA > 0) then
+
+     mp_Type_aV=MP_Type(av%iAttr)
+     call MPI_bcast(aV%iAttr,nIA*lsize,mp_Type_aV,root,comm,ier)
+     if(ier /= 0) then
+	call MP_perr_die(myname_,'MPI_bcast(iAttr) failed.',ier)
+     endif
+
+     call String_clean(iLStr)
+
+  endif
+
+  if(nRA > 0) then
+
+     mp_Type_aV=MP_Type(av%rAttr)
+     call MPI_bcast(aV%rAttr,nRA*lsize,mp_Type_aV,root,comm,ier)
+     if(ier /= 0) then
+	call MP_perr_die(myname_,'MPI_bcast(rAttr) failed.',ier)
+     endif
+
+     call String_clean(rLStr)
+
+  endif
+
+ end subroutine bcast_
+
+ end module m_AttrVectComms
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectReduce.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectReduce.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_AttrVectReduce.F90	(revision 4775)
@@ -0,0 +1,1108 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_AttrVectReduce.F90,v 1.17 2008-05-12 01:46:11 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_AttrVectReduce - Local/Distributed AttrVect Reduction Ops.
+!
+! !DESCRIPTION:  This module provides routines to perform reductions on 
+! the {\tt AttrVect} datatype.  These reductions can either be the types
+! of operations supported by MPI (currently, summation, minimum and 
+! maximum are available) that are applied either to all the attributes 
+! (both integer and real), or specific reductions applicable only to the
+! real attributes of an {\tt AttrVect}.  This module provides services 
+! for both local (i.e., one address space) and global (distributed) 
+! reductions.  The type of reduction is defined through use of one of 
+! the public data members of this module:
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value} & {\bf Action} \\
+!\hline
+!{\tt AttrVectSUM} & Sum \\
+!\hline
+!{\tt AttrVectMIN} & Minimum \\
+!\hline
+!{\tt AttrVectMAX} & Maximum \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! !INTERFACE:
+
+ module m_AttrVectReduce
+!
+! !USES:
+!
+!     No modules are used in the declaration section of this module.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: LocalReduce            ! Local reduction of all attributes
+      public :: LocalReduceRAttr       ! Local reduction of REAL attributes
+      public :: AllReduce              ! AllReduce for distributed AttrVect
+      public :: GlobalReduce           ! Local Reduce followed by AllReduce
+      public :: LocalWeightedSumRAttr  ! Local weighted sum of 
+                                       ! REAL attributes
+      public :: GlobalWeightedSumRAttr ! Global weighted sum of REAL 
+                                       ! attributes for a distrubuted 
+                                       ! AttrVect
+
+    interface LocalReduce ; module procedure LocalReduce_ ; end interface
+    interface LocalReduceRAttr
+       module procedure LocalReduceRAttr_ 
+    end interface
+    interface AllReduce
+       module procedure AllReduce_ 
+    end interface
+    interface GlobalReduce
+       module procedure GlobalReduce_ 
+    end interface
+    interface LocalWeightedSumRAttr; module procedure &
+       LocalWeightedSumRAttrSP_, &
+       LocalWeightedSumRAttrDP_
+    end interface
+    interface GlobalWeightedSumRAttr; module procedure &
+       GlobalWeightedSumRAttrSP_, &
+       GlobalWeightedSumRAttrDP_
+    end interface
+
+! !PUBLIC DATA MEMBERS:
+
+    public :: AttrVectSUM
+    public :: AttrVectMIN
+    public :: AttrVectMAX
+
+    integer, parameter :: AttrVectSUM = 1
+    integer, parameter :: AttrVectMIN = 2
+    integer, parameter :: AttrVectMAX = 3
+
+! !REVISION HISTORY:
+!
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - Created module 
+!           using routines originally prototyped in m_AttrVect.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_AttrVectReduce'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: LocalReduce_ - Local Reduction of INTEGER and REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt LocalReduce\_()} takes the input {\tt AttrVect} 
+! argument {\tt inAV}, and reduces each of its integer and real 
+! attributes, returning them in the output {\tt AttrVect} argument 
+! {\tt outAV}  (which is created by this routine).  The type of 
+! reduction is defined by the input {\tt INTEGER} argument {\tt action}.
+!  Allowed values for action are defined as public data members to this 
+!  module, and are summarized below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value} & {\bf Action} \\
+!\hline
+!{\tt AttrVectSUM} & Sum \\
+!\hline
+!{\tt AttrVectMIN} & Minimum \\
+!\hline
+!{\tt AttrVectMAX} & Maximum \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine LocalReduce_(inAV, outAV, action) 
+!
+! !USES:
+!
+      use m_realkinds,     only : FP
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_zero => zero
+      use m_AttrVect,      only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect,      only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),  intent(IN)  :: inAV
+      integer,         intent(IN)  :: action
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),  intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+! 16Apr02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LocalReduce_'
+
+  integer :: i,j
+
+        ! First Step:  create outAV from inAV (but with one element)
+
+  call AttrVect_init(outAV, inAV, lsize=1)
+
+  call AttrVect_zero(outAV)
+
+  select case(action)
+  case(AttrVectSUM) ! sum up each attribute...
+
+        ! Compute INTEGER and REAL attribute sums:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nIAttr(outAV)
+	   outAV%iAttr(i,1) = outAV%iAttr(i,1) + inAV%iAttr(i,j)
+	end do
+     end do
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j)
+	end do
+     end do
+
+  case(AttrVectMIN) ! find the minimum of each attribute...
+
+        ! Initialize INTEGER and REAL attribute minima:
+
+     do i=1,AttrVect_nIAttr(outAV)
+	outAV%iAttr(i,1) = inAV%iAttr(i,1)
+     end do
+
+     do i=1,AttrVect_nRAttr(outAV)
+	outAV%rAttr(i,1) = inAV%rAttr(i,1)
+     end do
+
+        ! Compute INTEGER and REAL attribute minima:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nIAttr(outAV)
+	   if(inAV%iAttr(i,j) < outAV%iAttr(i,1)) then
+	      outAV%iAttr(i,1) = inAV%iAttr(i,j)
+	   endif
+	end do
+     end do
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   if(inAV%rAttr(i,j) < outAV%rAttr(i,1)) then
+	      outAV%rAttr(i,1) = inAV%rAttr(i,j)
+	   endif
+	end do
+     end do
+
+  case(AttrVectMAX) ! find the maximum of each attribute...
+
+        ! Initialize INTEGER and REAL attribute maxima:
+
+     do i=1,AttrVect_nIAttr(outAV)
+	outAV%iAttr(i,1) = inAV%iAttr(i,1)
+     end do
+
+     do i=1,AttrVect_nRAttr(outAV)
+	outAV%rAttr(i,1) = inAV%rAttr(i,1)
+     end do
+
+        ! Compute INTEGER and REAL attribute maxima:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nIAttr(outAV)
+	   if(inAV%iAttr(i,j) > outAV%iAttr(i,1)) then
+	      outAV%iAttr(i,1) = inAV%iAttr(i,j)
+	   endif
+	end do
+     end do
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   if(inAV%rAttr(i,j) > outAV%rAttr(i,1)) then
+	      outAV%rAttr(i,1) = inAV%rAttr(i,j)
+	   endif
+	end do
+     end do
+
+  case default
+
+     write(stderr,'(2a,i8)') myname_,':: unrecognized action = ',action
+     call die(myname_)
+
+  end select
+
+ end subroutine LocalReduce_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: LocalReduceRAttr_ - Local Reduction of REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt LocalReduceRAttr\_()} takes the input 
+! {\tt AttrVect} argument {\tt inAV}, and reduces each of its {\tt REAL}
+! attributes, returning them in the output {\tt AttrVect} argument 
+! {\tt outAV} (which is created by this routine).  The type of reduction 
+! is defined by the input {\tt INTEGER} argument {\tt action}.  Allowed 
+! values for action are defined as public data members to this module 
+! (see the declaration section of {\tt m\_AttrVect}, and are summarized below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value} & {\bf Action} \\
+!\hline
+!{\tt AttrVectSUM} & Sum \\
+!\hline
+!{\tt AttrVectMIN} & Minimum \\
+!\hline
+!{\tt AttrVectMAX} & Maximum \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+!
+ subroutine LocalReduceRAttr_(inAV, outAV, action) 
+
+!
+! !USES:
+!
+      use m_realkinds,     only : FP
+
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List,          only : List
+      use m_List,          only : List_copy => copy
+      use m_List,          only : List_exportToChar => exportToChar
+      use m_List,          only : List_clean => clean
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_zero => zero
+      use m_AttrVect,      only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect,      only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      integer,                      intent(IN)  :: action
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+! 16Apr02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!  6May02 - J.W. Larson <larson@mcs.anl.gov> - added optional
+!           argument weights(:)
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - modified interface
+!           to return it to being a pure reduction operation.
+!  9May02 - J.W. Larson <larson@mcs.anl.gov> - renamed from 
+!           LocalReduceReals_() to LocalReduceRAttr_() to make
+!           the name more consistent with other module procedure
+!           names in this module.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LocalReduceRAttr_'
+
+  integer :: i,j
+  type(List) :: rList_copy
+
+
+        ! First Step:  create outAV from inAV (but with one element)
+ 
+        ! Superflous list copy circumvents SGI compiler bug
+  call List_copy(rList_copy,inAV%rList)
+  call AttrVect_init(outAV, rList=List_exportToChar(rList_copy), lsize=1)
+  call AttrVect_zero(outAV)
+  call List_clean(rList_copy)
+
+  select case(action)
+  case(AttrVectSUM) ! sum up each attribute...
+
+        ! Compute REAL attribute sums:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j)
+	end do
+     end do
+
+  case(AttrVectMIN) ! find the minimum of each attribute...
+
+        ! Initialize REAL attribute minima:
+
+     do i=1,AttrVect_nRAttr(outAV)
+	outAV%rAttr(i,1) = inAV%rAttr(i,1)
+     end do
+
+        ! Compute REAL attribute minima:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   if(inAV%rAttr(i,j) < outAV%rAttr(i,1)) then
+	      outAV%rAttr(i,1) = inAV%rAttr(i,j)
+	   endif
+	end do
+     end do
+
+  case(AttrVectMAX) ! find the maximum of each attribute...
+
+        ! Initialize REAL attribute maxima:
+
+     do i=1,AttrVect_nRAttr(outAV)
+	outAV%rAttr(i,1) = inAV%rAttr(i,1)
+     end do
+
+        ! Compute REAL attribute maxima:
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(outAV)
+	   if(inAV%rAttr(i,j) > outAV%rAttr(i,1)) then
+	      outAV%rAttr(i,1) = inAV%rAttr(i,j)
+	   endif
+	end do
+     end do
+
+  case default
+
+     write(stderr,'(2a,i8)') myname_,':: unrecognized action = ',action
+     call die(myname_)
+
+  end select
+
+ end subroutine LocalReduceRAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: AllReduce_ - Reduction of INTEGER and REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt AllReduce\_()} takes the distributed input 
+! {\tt AttrVect} argument {\tt inAV}, and performs a global reduction 
+! of all its attributes across the MPI communicator associated with 
+! the Fortran90 {\tt INTEGER} handle {\tt comm}, and returns these
+! reduced values to all processes in the {\tt AttrVect} argument 
+! {\tt outAV} (which is created by this routine).  The reduction 
+! operation is specified by the user, and must have one of the values 
+! listed in the table below:
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value} & {\bf Action} \\
+!\hline
+!{\tt AttrVectSUM} & Sum \\
+!\hline
+!{\tt AttrVectMIN} & Minimum \\
+!\hline
+!{\tt AttrVectMAX} & Maximum \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+!
+
+ subroutine AllReduce_(inAV, outAV, ReductionOp, comm, ierr)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio ,        only : stderr
+      use m_mpif90
+
+      use m_List,          only : List
+      use m_List,          only : List_exportToChar => exportToChar
+      use m_List,          only : List_allocated => allocated
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_zero => zero
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+      use m_AttrVect,      only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect,      only : AttrVect_nRAttr => nRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      integer,                      intent(IN)  :: ReductionOp
+      integer,                      intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+      integer,        optional,     intent(OUT) :: ierr
+
+! !REVISION HISTORY:
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!  9Jul02 - J.W. Larson <larson@mcs.anl.gov> - slight modification;
+!           use List_allocated() to determine if there is attribute
+!           data to be reduced (this patch is to support the Sun
+!           F90 compiler).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::AllReduce_'
+
+  integer :: BufferSize, myID, ier
+
+       ! Initialize ierr (if present) to "success" value
+  if(present(ierr)) ierr = 0
+
+  call MPI_COMM_RANK(comm, myID, ier)
+  if(ier /= 0) then
+     write(stderr,'(2a)') myname_,':: MPI_COMM_RANK() failed.'
+     call MP_perr_die(myname_, 'MPI_COMM_RANK() failed.', ier)
+  endif
+
+  call AttrVect_init(outAV, inAV, lsize=AttrVect_lsize(inAV))
+  call AttrVect_zero(outAV)
+
+  if(List_allocated(inAV%rList)) then ! invoke MPI_AllReduce() for the real
+                                      ! attribute data.
+     BufferSize = AttrVect_lsize(inAV) * AttrVect_nRAttr(inAV)
+
+     select case(ReductionOp)
+     case(AttrVectSUM)
+	call MPI_AllReduce(inAV%rAttr, outAV%rAttr, BufferSize, &
+	                   MP_Type(inAV%rAttr(1,1)), MP_SUM, &
+	                   comm, ier)
+     case(AttrVectMIN)
+	call MPI_AllReduce(inAV%rAttr, outAV%rAttr, BufferSize, &
+                           MP_Type(inAV%rAttr(1,1)), MP_MIN, &
+                           comm, ier)
+     case(AttrVectMAX)
+	call MPI_AllReduce(inAV%rAttr, outAV%rAttr, BufferSize, &
+                           MP_Type(inAV%rAttr(1,1)), MP_MAX, &
+                           comm, ier)
+     case default
+	write(stderr,'(2a,i8,a)') myname_, &
+                                  '::FATAL ERROR--value of RedctionOp=', &
+                                  ReductionOp,' not supported.'
+     end select
+
+     if(ier /= 0) then
+	write(stderr,*) myname_, &
+	     ':: Fatal Error in MPI_AllReduce(), myID = ',myID
+	call MP_perr_die(myname_, 'MPI_AllReduce() failed.', ier)
+     endif
+
+  endif ! if(List_allocated(inAV%rList))...
+
+  if(List_allocated(inAV%iList)) then ! invoke MPI_AllReduce() for the 
+                                      ! integer attribute data.
+
+     BufferSize = AttrVect_lsize(inAV) * AttrVect_nIAttr(inAV)
+
+     select case(ReductionOp)
+     case(AttrVectSUM)
+	call MPI_AllReduce(inAV%iAttr, outAV%iAttr, BufferSize, &
+	                   MP_Type(inAV%iAttr(1,1)), MP_SUM, &
+	                   comm, ier)
+     case(AttrVectMIN)
+	call MPI_AllReduce(inAV%iAttr, outAV%iAttr, BufferSize, &
+                           MP_Type(inAV%iAttr(1,1)), MP_MIN, &
+                           comm, ier)
+     case(AttrVectMAX)
+	call MPI_AllReduce(inAV%iAttr, outAV%iAttr, BufferSize, &
+                           MP_Type(inAV%iAttr(1,1)), MP_MAX, &
+                           comm, ier)
+     case default
+	write(stderr,'(2a,i8,a)') myname_, &
+                                  '::FATAL ERROR--value of RedctionOp=', &
+                                  ReductionOp,' not supported.'
+     end select
+
+     if(ierr /= 0) then
+	write(stderr,*) myname_, &
+	     ':: Fatal Error in MPI_AllReduce(), myID = ',myID
+	call MP_perr_die(myname_, 'MPI_AllReduce() failed.', ier)
+     endif
+  endif ! if(List_allocated(inAV%iList))...
+
+  if(present(ierr)) ierr = ier
+
+ end subroutine AllReduce_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalReduce_ - Reduction of INTEGER and REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt GlobalReduce\_()} takes the distributed input 
+! {\tt AttrVect} argument {\tt inAV}, and performs a local reduction of 
+! all its integer and real attributes, followed by a an {\tt AllReduce}
+! of all the result of the local reduction across the MPI communicator 
+! associated with the Fortran90 {\tt INTEGER} handle {\tt comm}, and 
+! returns these reduced values to all processes in the {\tt AttrVect} 
+! argument {\tt outAV} (which is created by this routine).  The reduction 
+! operation is specified by the user, and must have one of the values 
+! listed in the table below:
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value} & {\bf Action} \\
+!\hline
+!{\tt AttrVectSUM} & Sum \\
+!\hline
+!{\tt AttrVectMIN} & Minimum \\
+!\hline
+!{\tt AttrVectMAX} & Maximum \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+!
+
+ subroutine GlobalReduce_(inAV, outAV, ReductionOp, comm, ierr)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio ,        only : stderr
+      use m_mpif90
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      integer,                      intent(IN)  :: ReductionOp
+      integer,                      intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+      integer,        optional,     intent(OUT) :: ierr
+
+! !REVISION HISTORY:
+!  6May03 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalReduce_'
+  type(AttrVect) :: LocalResult
+
+  ! Step One:  On-PE reduction
+
+  call LocalReduce_(inAV, LocalResult, ReductionOp)
+
+  ! Step Two:  An AllReduce on the distributed local reduction results
+
+  if(present(ierr)) then
+     call AllReduce_(LocalResult, outAV, ReductionOp, comm, ierr)
+  else
+     call AllReduce_(LocalResult, outAV, ReductionOp, comm)
+  endif
+
+  ! Step Three:  Clean up and return.
+
+  call AttrVect_clean(LocalResult)
+
+ end subroutine GlobalReduce_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: LocalWeightedSumRAttrSP_ - Local Weighted Sum of REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt LocalWeightedSumRAttr\_()} takes the input 
+! {\tt AttrVect} argument {\tt inAV}, and performs a weighted sum
+! of  each of its {\tt REAL} attributes, returning them in the output 
+! {\tt AttrVect} argument {\tt outAV} (which is created by this routine
+! and  will contain {\em no} integer attributes).  The weights used 
+! for the summation are provided by the user in the input argument 
+! {\tt Weights(:)}.  If the sum of the weights is desired, this can be 
+! returned as an attribute in {\tt outAV} if the optional {\tt CHARACTER} 
+! argument {\tt WeightSumAttr} is provided (which will be concatenated 
+! onto the list of real attributes in {\tt inAV}).
+!
+! {\bf N.B.}:  The argument {\tt WeightSumAttr} must not be identical
+! to any of the real attribute names in {\tt inAV}.  
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+!
+ subroutine LocalWeightedSumRAttrSP_(inAV, outAV, Weights, WeightSumAttr) 
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_realkinds,     only : SP, FP
+
+      use m_List,          only : List
+      use m_List,          only : List_init => init
+      use m_List,          only : List_clean => clean
+      use m_List,          only : List_exportToChar => exportToChar
+      use m_List,          only : List_concatenate => concatenate
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_zero => zero
+      use m_AttrVect,      only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect,      only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      real(SP), dimension(:),       pointer     :: Weights
+      character(len=*),   optional, intent(IN)  :: WeightSumAttr
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! 14Jun02 - J.W. Larson <larson@mcs.anl.gov> - bug fix regarding
+!           accumulation of weights when invoked with argument
+!           weightSumAttr.  Now works in MCT unit tester.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LocalWeightedSumRAttrSP_'
+
+  integer :: i,j
+  type(List) dummyList1, dummyList2
+
+        ! Check for consistencey between inAV and the weights array
+
+  if(size(weights) /= AttrVect_lsize(inAV)) then
+     write(stderr,'(4a)') myname_,':: ERROR--mismatch in lengths of ', &
+	  'input array array argument weights(:) and input AttrVect ',&
+	  'inAV.'
+     write(stderr,'(2a,i8)') myname_,':: size(weights)=',size(weights)
+     write(stderr,'(2a,i8)') myname_,':: length of inAV=', &
+	  AttrVect_lsize(inAV)
+     call die(myname_)
+  endif
+
+        ! First Step:  create outAV from inAV (but with one element)
+
+  if(present(WeightSumAttr)) then
+     call List_init(dummyList1,WeightSumAttr)
+     call List_concatenate(inAV%rList, dummyList1, dummyList2)
+     call AttrVect_init(outAV, rList=List_exportToChar(dummyList2), &
+	                lsize=1)
+     call List_clean(dummyList1)
+     call List_clean(dummyList2)
+  else
+     call AttrVect_init(outAV, rList=List_exportToChar(inAV%rList), lsize=1)
+  endif
+
+        ! Initialize REAL attribute sums:
+  call AttrVect_zero(outAV)
+
+        ! Compute REAL attribute sums:
+
+  if(present(WeightSumAttr)) then ! perform weighted sum AND sum weights
+
+     do j=1,AttrVect_lsize(inAV)
+
+	do i=1,AttrVect_nRAttr(inAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j) * weights(j)
+	end do
+        ! The final attribute is the sum of the weights
+	outAV%rAttr(AttrVect_nRAttr(outAV),1) = &
+	                   outAV%rAttr(AttrVect_nRAttr(outAV),1) + weights(j)
+     end do
+
+  else ! only perform weighted sum
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(inAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j) * weights(j)
+	end do
+     end do
+
+  endif ! if(present(WeightSumAttr))...
+
+ end subroutine LocalWeightedSumRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: LocalWeightedSumRAttrDP_ - Local Weighted Sum of REAL Attributes
+!
+! !DESCRIPTION:
+! Double precision version of LocalWeightedSumRAttrSP_
+!
+! !INTERFACE:
+!
+ subroutine LocalWeightedSumRAttrDP_(inAV, outAV, Weights, WeightSumAttr) 
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+      use m_realkinds,     only : DP, FP
+
+      use m_List,          only : List
+      use m_List,          only : List_init => init
+      use m_List,          only : List_clean => clean
+      use m_List,          only : List_exportToChar => exportToChar
+      use m_List,          only : List_concatenate => concatenate
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_zero => zero
+      use m_AttrVect,      only : AttrVect_nIAttr => nIAttr
+      use m_AttrVect,      only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      real(DP), dimension(:),       pointer     :: Weights
+      character(len=*),   optional, intent(IN)  :: WeightSumAttr
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! 14Jun02 - J.W. Larson <larson@mcs.anl.gov> - bug fix regarding
+!           accumulation of weights when invoked with argument
+!           weightSumAttr.  Now works in MCT unit tester.
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LocalWeightedSumRAttrDP_'
+
+  integer :: i,j
+  type(List) dummyList1, dummyList2
+
+        ! Check for consistencey between inAV and the weights array
+
+  if(size(weights) /= AttrVect_lsize(inAV)) then
+     write(stderr,'(4a)') myname_,':: ERROR--mismatch in lengths of ', &
+	  'input array array argument weights(:) and input AttrVect ',&
+	  'inAV.'
+     write(stderr,'(2a,i8)') myname_,':: size(weights)=',size(weights)
+     write(stderr,'(2a,i8)') myname_,':: length of inAV=', &
+	  AttrVect_lsize(inAV)
+     call die(myname_)
+  endif
+
+        ! First Step:  create outAV from inAV (but with one element)
+
+  if(present(WeightSumAttr)) then
+     call List_init(dummyList1,WeightSumAttr)
+     call List_concatenate(inAV%rList, dummyList1, dummyList2)
+     call AttrVect_init(outAV, rList=List_exportToChar(dummyList2), &
+	                lsize=1)
+     call List_clean(dummyList1)
+     call List_clean(dummyList2)
+  else
+     call AttrVect_init(outAV, rList=List_exportToChar(inAV%rList), lsize=1)
+  endif
+
+        ! Initialize REAL attribute sums:
+  call AttrVect_zero(outAV)
+
+        ! Compute REAL attribute sums:
+
+  if(present(WeightSumAttr)) then ! perform weighted sum AND sum weights
+
+     do j=1,AttrVect_lsize(inAV)
+
+	do i=1,AttrVect_nRAttr(inAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j) * weights(j)
+	end do
+        ! The final attribute is the sum of the weights
+	outAV%rAttr(AttrVect_nRAttr(outAV),1) = &
+	                   outAV%rAttr(AttrVect_nRAttr(outAV),1) + weights(j)
+     end do
+
+  else ! only perform weighted sum
+
+     do j=1,AttrVect_lsize(inAV)
+	do i=1,AttrVect_nRAttr(inAV)
+	   outAV%rAttr(i,1) = outAV%rAttr(i,1) + inAV%rAttr(i,j) * weights(j)
+	end do
+     end do
+
+  endif ! if(present(WeightSumAttr))...
+
+ end subroutine LocalWeightedSumRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalWeightedSumRAttrSP_ - Global Weighted Sum of REAL Attributes
+!
+! !DESCRIPTION:
+!
+! The subroutine {\tt GlobalWeightedSumRAttr\_()} takes the 
+! distributed input {\tt AttrVect} argument {\tt inAV}, and performs 
+! a weighted global sum across the MPI communicator associated with 
+! the Fortran90 {\tt INTEGER} handle {\tt comm} of each of its 
+! {\tt REAL} attributes, returning the sums to each process in the
+! {\tt AttrVect} argument {\tt outAV} (which is created by this routine
+! and will contain {\em no} integer attributes).  The weights used for 
+! the summation are provided by the user in the input argument 
+! {\tt weights(:)}.  If the sum of the weights is desired, this can be 
+! returned as an attribute in {\tt outAV} if the optional {\tt CHARACTER} 
+! argument {\tt WeightSumAttr} is provided (which will be concatenated 
+! onto the list of real attributes in {\tt inAV} to form the list of 
+! real attributes for {\tt outAV}).
+!
+! {\bf N.B.}:  The argument {\tt WeightSumAttr} must not be identical
+! to any of the real attribute names in {\tt inAV}.  
+!
+! {\bf N.B.}:  The output {\tt AttrVect} argument {\tt outAV} is
+! allocated memory, and must be destroyed by invoking the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+!
+ subroutine GlobalWeightedSumRAttrSP_(inAV, outAV, Weights, comm, &
+                                    WeightSumAttr) 
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio ,        only : stderr
+      use m_mpif90
+      use m_realkinds,     only : SP
+
+      use m_List,          only : List
+      use m_List,          only : List_exportToChar => exportToChar
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_clean => clean
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      real(SP), dimension(:),       pointer     :: Weights
+      integer,                      intent(IN)  :: comm
+      character(len=*),   optional, intent(IN)  :: WeightSumAttr
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalWeightedSumRAttrSP_'
+
+  type(AttrVect) :: LocallySummedAV
+  integer :: myID, ierr
+
+        ! Get local process rank (for potential error reporting purposes)
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_COMM_RANK() error.',ierr)
+  endif
+
+        ! Check for consistencey between inAV and the weights array
+
+  if(size(weights) /= AttrVect_lsize(inAV)) then
+     write(stderr,'(2a,i8,3a)') myname_,':: myID=',myID, &
+	  'ERROR--mismatch in lengths of ', &
+	  'input array array argument weights(:) and input AttrVect ',&
+	  'inAV.'
+     write(stderr,'(2a,i8)') myname_,':: size(weights)=',size(weights)
+     write(stderr,'(2a,i8)') myname_,':: length of inAV=', &
+	  AttrVect_lsize(inAV)
+     call die(myname_)
+  endif
+
+  if(present(WeightSumAttr)) then
+     call LocalWeightedSumRAttrSP_(inAV, LocallySummedAV, Weights, &
+	                         WeightSumAttr)
+  else
+     call LocalWeightedSumRAttrSP_(inAV, LocallySummedAV, Weights)
+  endif
+
+  call AllReduce_(LocallySummedAV, outAV, AttrVectSUM, comm, ierr)
+
+       ! Clean up intermediate local sums
+
+  call AttrVect_clean(LocallySummedAV)
+
+ end subroutine GlobalWeightedSumRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: GlobalWeightedSumRAttrDP_ - Global Weighted Sum of REAL Attributes
+!
+! !DESCRIPTION:
+! Double precision version of GlobalWeightedSumRAttrSP_
+!
+! !INTERFACE:
+!
+ subroutine GlobalWeightedSumRAttrDP_(inAV, outAV, Weights, comm, &
+                                    WeightSumAttr) 
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio ,        only : stderr
+      use m_mpif90
+      use m_realkinds,     only : DP
+
+      use m_List,          only : List
+      use m_List,          only : List_exportToChar => exportToChar
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_clean => clean
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)  :: inAV
+      real(DP), dimension(:),       pointer     :: Weights
+      integer,                      intent(IN)  :: comm
+      character(len=*),   optional, intent(IN)  :: WeightSumAttr
+
+! !OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(OUT) :: outAV
+
+! !REVISION HISTORY:
+!  8May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalWeightedSumRAttrDP_'
+
+  type(AttrVect) :: LocallySummedAV
+  integer :: myID, ierr
+
+        ! Get local process rank (for potential error reporting purposes)
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_COMM_RANK() error.',ierr)
+  endif
+
+        ! Check for consistencey between inAV and the weights array
+
+  if(size(weights) /= AttrVect_lsize(inAV)) then
+     write(stderr,'(2a,i8,3a)') myname_,':: myID=',myID, &
+	  'ERROR--mismatch in lengths of ', &
+	  'input array array argument weights(:) and input AttrVect ',&
+	  'inAV.'
+     write(stderr,'(2a,i8)') myname_,':: size(weights)=',size(weights)
+     write(stderr,'(2a,i8)') myname_,':: length of inAV=', &
+	  AttrVect_lsize(inAV)
+     call die(myname_)
+  endif
+
+  if(present(WeightSumAttr)) then
+     call LocalWeightedSumRAttrDP_(inAV, LocallySummedAV, Weights, &
+	                         WeightSumAttr)
+  else
+     call LocalWeightedSumRAttrDP_(inAV, LocallySummedAV, Weights)
+  endif
+
+  call AllReduce_(LocallySummedAV, outAV, AttrVectSUM, comm, ierr)
+
+       ! Clean up intermediate local sums
+
+  call AttrVect_clean(LocallySummedAV)
+
+ end subroutine GlobalWeightedSumRAttrDP_
+
+ end module m_AttrVectReduce
+!.
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ConvertMaps.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ConvertMaps.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ConvertMaps.F90	(revision 4775)
@@ -0,0 +1,438 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_ConvertMaps.F90,v 1.10 2004-04-21 22:16:32 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_ConvertMaps - Conversion Between MCT Domain Decomposition Descriptors
+!
+! !DESCRIPTION:
+!
+! This module contains routines to convert between the {\tt GlobalMap} 
+! and {\tt GlobalSegMap} types.  Since the {\tt GlobalMap} is a 1-D 
+! decomposition with one contiguous segment per process, it is always 
+! possible to create a {\tt GlobalSegMap} containing the same decomposition
+! information.  In the unusual case that a {\tt GlobalSegMap} contains 
+! {\em at most} one segment per process, and no two segments overlap, it 
+! is possible to create a {\tt GlobalMap} describing the same decomposition.
+!
+! !INTERFACE:
+
+ module m_ConvertMaps
+!
+! !USES:
+!
+      use m_GlobalMap,    only : GlobalMap
+      use m_GlobalSegMap, only : GlobalSegMap
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: GlobalMapToGlobalSegMap
+      public :: GlobalSegMapToGlobalMap
+
+
+    interface GlobalMapToGlobalSegMap ; module procedure &
+        GlobalMapToGlobalSegMap_
+    end interface
+    interface GlobalSegMapToGlobalMap ; module procedure &
+        GlobalSegMapToGlobalMap_
+    end interface
+
+! !REVISION HISTORY:
+! 12Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial module
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_ConvertMap'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalMapToGlobalSegMap_ - Convert GlobalMap to GlobalSegMap
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt GlobalMap} argument {\tt GMap}, and
+! converts its decomposition information into the output {\tt GlobalSegMap}
+! argument {\tt GSMap}.  Since the {\tt GlobalMap} is a very special case
+! of the more general {\tt GlobalSegMap} decomposition, this conversion is
+! always possible.
+!
+! The motivation of this routine is the fact that the majority of the 
+! APIs for MCT services require the user to supply a {\tt GlobalSegMap} 
+! as a domain decomposition descriptor argument.  This routine is the
+! means by which the user can enjoy the convenience and simplicity of 
+! the {\tt GlobalMap} datatype (where it is appropriate), but still 
+! access all of the MCT's functionality.
+!
+! {\bf N.B.:}  This routine creates an allocated structure {\tt GSMap}.
+! The user is responsible for deleting this structure using the {\tt clean()}
+! method for the {\tt GlobalSegMap} when {\tt GSMap} is no longer needed.
+! Failure to do so will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine GlobalMapToGlobalSegMap_(GMap, GSMap)
+
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : MP_perr_die, die, warn
+
+      use m_GlobalMap,    only : GlobalMap
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+
+      use m_MCTWorld, only : ThisMCTWorld
+      use m_MCTWorld, only : MCTWorld_ComponentNumProcs => ComponentNumProcs
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap),    intent(in)  :: GMap
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(out) :: GSMap
+
+! !REVISION HISTORY:
+! 12Feb01 - J.W. Larson <larson@mcs.anl.gov> - Prototype code.
+! 24Feb01 - J.W. Larson <larson@mcs.anl.gov> - Finished code.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalMapToGlobalSegMap_'
+
+  integer :: ierr, n, NumProcs
+  integer, dimension(:), allocatable :: start, length, pe_loc
+
+       ! Sanity Check -- is GMap the right size?
+
+  NumProcs = MCTWorld_ComponentNumProcs(ThisMCTWorld, GMap%comp_id)
+  if(NumProcs /= size(GMap%displs)) then
+     call warn(myname_,"component/GlobalMap size mismatch")
+     call die(myname_,":: Size mismatch-NumProcs = ", &
+	  NumProcs,"size(GMap%displs) = ",size(GMap%displs))
+  endif
+
+       ! Allocate space for process location
+
+  allocate(start(NumProcs), length(NumProcs), pe_loc(NumProcs), stat=ierr)
+  if(ierr /= 0) call die(myname_,"allocate(start(NumProcs...",ierr)
+
+       ! Load the arrays:
+
+  do n=1,NumProcs
+     start(n) = GMap%displs(n-1) + 1
+     length(n) = GMap%counts(n-1)
+     pe_loc(n) = n-1
+  end do
+
+  call GlobalSegMap_init(GSMap, GMap%comp_id, NumProcs, GMap%gsize, &
+                         start, length, pe_loc)
+
+       ! Clean up...
+
+  deallocate(start, length, pe_loc, stat=ierr)
+  if(ierr /= 0) call die(myname_,"deallocate(start,...",ierr)
+
+ end subroutine GlobalMapToGlobalSegMap_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToGlobalMap_ - Convert GlobalSegMap to GlobalMap
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt GlobalSegMap} argument {\tt GSMap}, 
+! and examines it to determine whether or not it may be expressed in 
+! {\tt GlobalMap} form.  A {\tt GlobalSegMap} can be converted to a 
+! {\tt GlobalMap} if and only if:
+! \begin{enumerate}
+! \item Each process on the communicator covered by the 
+! {\tt GlobalSegMap} contains {\em at most one} segment;
+! \item The {\tt GlobalSegMap} is {\em not} haloed (that is, none of
+! the segments overlap); and
+! \item The start indices of the segments are in the same order as their 
+! respective process ID numbers.
+! \end{enumerate}
+! If these conditions are satisfied, {\tt GlobalSegMapToGlobalMap\_()} 
+! creates an output {\tt GlobalMap} argument {\tt GMap} describing the 
+! same decomposition as {\tt GSMap}.  If these conditions are not satisfied,
+! map conversion can not occur, and {\tt GlobalSegMapToGlobalMap\_()} 
+! has one of two outcomes:
+! \begin{enumerate}
+! \item If the optional output {\tt INTEGER} argument {\tt status} is 
+! provided, {\tt GlobalSegMapToGlobalMap\_()} returns without creating 
+! {\tt GMap}, and returns a non-zero value for {\tt status}.
+! \item If the optional output {\tt INTEGER} argument {\tt status} is 
+! not provided, execution will terminate with an error message.
+! \end{enumerate}
+!
+! The optional output {\tt INTEGER} argument {\tt status}, if provided
+! will be returned from {\tt GlobalSegMapToGlobalMap\_()} with a value
+! explained by the table below:
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Value of {\tt status}} & {\bf Significance} \\
+!\hline
+!{\tt 0} & Map Conversion Successful \\
+!\hline
+!{\tt 1} & Unsuccessful--more than one segment per process, \\
+! & or a negative numer of segments (ERROR) \\
+!\hline
+!{\tt 2} & Unsuccessful--{\tt GSMap} haloed \\
+!\hline
+!{\tt 3} & Unsuccessful--{\tt GSMap} segments out-of-order \\
+! & with respect to resident process ID ranks \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! {\bf N.B.:}  This routine creates an allocated structure {\tt GMap}.
+! The user is responsible for deleting this structure using the {\tt clean()}
+! method for the {\tt GlobalMap} when {\tt GMap} is no longer needed.
+! Failure to do so will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine GlobalSegMapToGlobalMap_(GSMap, GMap, status)
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : MP_perr_die, die
+
+      use m_SortingTools , only : IndexSet
+      use m_SortingTools , only : IndexSort
+      use m_SortingTools , only : Permute
+
+      use m_MCTWorld, only : MCTWorld
+      use m_MCTWorld, only : ThisMCTWorld
+      use m_MCTWorld, only : ComponentNumProcs
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_id
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_haloed => haloed
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg
+      use m_GlobalSegMap, only : GlobalSegMap_active_pes => active_pes
+
+      use m_GlobalMap,    only : GlobalMap
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),           intent(in)  :: GSMap
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalMap),              intent(out) :: GMap
+      integer,            optional, intent(out) :: status
+
+! !REVISION HISTORY:
+! 12Feb01 - J.W. Larson <larson@mcs.anl.gov> - API / first prototype.
+! 21Sep02 - J.W. Larson <larson@mcs.anl.gov> - Near-complete Implementation,
+!           still, do not call!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToGlobalMap_'
+
+  integer :: i, ierr, n
+  integer :: nlseg, NumActive, NumProcs, NumPEs, NGSegs
+  integer, dimension(:), pointer :: NumSegs
+  integer, dimension(:), pointer :: GSMstarts, GSMlengths, GSMpe_locs, perm
+  logical :: convertible
+
+       ! If the status flag is present, set it to the "success" value:
+
+  if(present(status)) then
+     status = 0
+  endif
+
+       ! How many segments are there in GSMap?  If the number of 
+       ! segments is greater than the number of processes on the
+       ! GlobalSegMap's native communicator conversion to a 
+       ! GlobalMap is not possible.  If the number of segments is 
+       ! fewer than the number of PEs, further checks are necessary
+       ! to determine whether map conversion is possible.
+
+  NumPEs = ComponentNumProcs(ThisMCTWorld, GlobalSegMap_comp_id(GSMap))
+  NGSegs = GlobalSegMap_ngseg(GSMap)
+
+  if(NGSegs > NumPEs) then
+     write(stderr,'(3a,i8,a,i8,2a)') myname_, &
+	  ':: Conversion of input GlobalSegMap to GlobalMap not possible.', &
+	  '  Number of segments is greater than number of PEs.  NumPEs = ', &
+	  NumPEs,' NGSegs = ', NGSegs,'.  See MCT API Document for more', &
+	  ' information.'
+     if(present(status)) then
+	status = 1
+	return
+     else
+	call die(myname_)
+     endif
+  endif
+
+       ! Is GSMap haloed?  If it is, map conversion is impossible
+
+  if(GlobalSegMap_haloed(GSMap)) then
+     write(stderr,'(3a)') myname_, &
+	  ':: input GlobalSegMap is haloed.  Conversion to GlobalMap ', &
+	  ' type not possible.  See MCT API Document for details.'
+     if(present(status)) then
+	status = 2
+	return
+     else
+	call die(myname_)
+     endif
+  endif
+
+       ! At this point, we've done the easy tests. 
+
+       ! Return to the first condition:  at most one segment per PE.
+       ! We've eliminated the obvious case of more segments than PEs.
+       ! Now, we examine the case of fewer segments than PEs, to see 
+       ! if any single PE has more than one segment.
+
+  allocate(NumSegs(0:NumPes-1), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate(NumSegs(1:NumPes-1))=',ierr)
+
+  do n=0,NumPes-1
+
+       ! Is there at most one segment per process?  If not, then
+       ! map conversion is impossible.
+
+     NumSegs(n) = GlobalSegMap_nlseg(GSMap, n)
+
+     if((NumSegs(n) > 1) .or. (NumSegs(n) < 0)) then ! fails GMap
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: ERROR:  Map conversion not possible due to ', &
+	     'inappropriate number of segments on PE number ', &
+	     n,'.  Number of segments = ',NumSegs(n)
+	deallocate(NumSegs, stat=ierr)
+	if(ierr /= 0) then ! problem cleaning up
+	   write(stderr,'(3a)') myname_, &
+		':: Encountered error deallocating NumSegs ', &
+		'while exiting.'
+	endif
+	if(present(status)) then ! return with error code
+	   status = 1
+	   return
+	else
+	   call die(myname_)
+	endif
+     endif
+
+  end do ! do n=0,NumPes-1
+  
+  deallocate(NumSegs, stat=ierr)
+  if(ierr /= 0) call die(myname_,'deallocate(NumSegs,...)',ierr)
+
+       ! If execution has reached this point in the code, GSMap has
+       ! satisfied the first two criteria for conversion to a GlobalMap.
+       ! The final test is whether or not the global start indices for 
+       ! the segments (which we know by now are at most one per PE) are
+       ! in the same order as their resident process ID ranks.
+
+       ! Extract start, length, and PE location arrays from GSMap:
+
+  allocate(GSMstarts(NGSegs), GSMlengths(NGSegs), GSMpe_locs(NGSegs), &
+           perm(NGSegs), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate(GSMstarts,...)=',ierr)
+
+  do i=1,NGSegs
+     GSMstarts(i) = GSMap%start(i)
+     GSMlengths(i) = GSMap%length(i)
+     GSMpe_locs(i) = GSMap%pe_loc(i)
+  end do
+
+       ! Begin sorting process.  First, set index permutation.
+  call IndexSet(perm)
+       ! Generate sort permutation keyed by PE location
+  call IndexSort(NGSegs, perm, GSMpe_locs, descend=.false.) 
+       ! Permute segment info arrays using perm(:)
+  call Permute(GSMstarts, perm, NGSegs)
+  call Permute(GSMlengths, perm, NGSegs)
+  call Permute(GSMpe_locs, perm, NGSegs)
+
+       ! Now that these arrays are ordered by PE location, we
+       ! can check the segment start ordering to see if it is
+       ! the same.  Start with the assumption they are in order,
+       ! corrsponding to convertible=.TRUE.
+
+  convertible = .TRUE.
+  ORDER_TEST: do i=1,NGSegs-1
+     if(GSMstarts(i) <= GSMstarts(i+1)) then
+	CYCLE
+     else
+	convertible = .FALSE.
+	EXIT
+     endif
+  end do ORDER_TEST
+
+  if(convertible) then ! build output GlobalMap GMAP
+
+       ! Integer components:
+
+     GMap%comp_id = GlobalSegMap_comp_id(GSMap)
+     GMap%gsize = GlobalSegMap_gsize(GSMap)
+
+       ! lsize is not defined in this case!!! -ETO
+!     GMap%lsize = GlobalSegMap_lsize(GSMap)
+     GMap%lsize = -1
+
+       ! Indexing components:
+
+     allocate(GMap%displs(0:NumPEs-1), GMap%counts(0:NumPEs-1), stat=ierr)
+
+       ! Set the counts(:) values to zero, then copy in the non-zero
+       ! segment length values
+
+     GMap%counts = 0
+     do i=1,NGSegs
+	GMap%counts(GSMpe_locs(i)) = GSMlengths(i)
+     end do
+
+       ! From counts(:), build displs(:)
+	GMap%displs(0) = 0
+     do i=1,NumPEs-1
+	GMap%displs(i) = GMap%displs(i-1) + GMap%counts(i-1)
+     end do
+
+  else ! Nullify it
+
+     GMap%comp_id = -1
+     GMap%gsize = -1
+     GMap%lsize = -1
+     nullify(GMap%displs)
+     nullify(GMap%counts)
+
+  endif
+
+  deallocate(GSMstarts, GSMlengths, GSMpe_locs, perm, stat=ierr)
+  if(ierr /= 0) call die(myname_,'deallocate(GSMstarts,...)=',ierr)
+
+ end subroutine GlobalSegMapToGlobalMap_
+
+ end module m_ConvertMaps
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ExchangeMaps.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ExchangeMaps.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_ExchangeMaps.F90	(revision 4775)
@@ -0,0 +1,613 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_ExchangeMaps.F90,v 1.19 2004-04-21 22:16:32 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_ExchangeMaps - Exchange of Global Mapping Objects.
+!
+! !DESCRIPTION:
+! This module contains routines that support the exchange of domain 
+! decomposition descriptors (DDDs) between two MCT components.  There is 
+! support for {\em handshaking} between the two components to determine 
+! the types of domain decomposition descriptors they employ, {\em loading} 
+! of data contained within domain decomposition descriptors, and {\em 
+! map exchange}, resulting in the creation of a remote component's domain
+! decomposition descriptor for use by a local component.  These routines 
+! are largely used by MCT's {\tt Router} to create intercomponent 
+! communications scheduler, and normally should not be used by an MCT 
+! user.
+!
+! Currently, the types of map exchange supported by the public routine 
+! {\tt ExchangeMap()} are summarized in the table below.  The first column
+! lists the type of DDD used locally on the component invoking 
+! {\tt ExchangeMap()} (i.e., the input DDD).  The second comlumn lists 
+! the DDD type used on the remote component (i.e., the output DDD).
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|}
+!\hline
+!{\bf Local DDD Type} & {\bf Remote DDD Type} \\
+!\hline
+!{\tt GlobalMap} & {\tt GlobalSegMap} \\
+!\hline
+!{\tt GlobalSegMap} & {\tt GlobalSegMap} \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! Currently, we do not support intercomponent map exchange where a 
+! {\tt GlobalMap} is output.  The rationale for this is that any {\tt GlobalMap}
+! may always be expressed as a {\tt GlobalSegMap}.
+!
+! !INTERFACE:
+
+ module m_ExchangeMaps
+
+! !USES:
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private   ! except
+!
+! !PUBLIC MEMBER FUNCTIONS:
+!
+      public :: ExchangeMap
+
+      interface ExchangeMap ; module procedure   &
+           ExGSMapGSMap_, &  ! GlobalSegMap for GlobalSegMap
+           ExGMapGSMap_
+      end interface
+
+! !SEE ALSO:
+! The MCT module m_ConvertMaps for more information regarding the 
+! relationship between the GlobalMap and GlobalSegMap types.
+! The MCT module m_Router to see where these services are used to 
+! create intercomponent communications schedulers.
+!
+! !REVISION HISTORY:
+!  3Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial module
+!  3Aug01 - E.T. Ong <eong@mcs.anl.gov> - in ExGSMapGSMap,
+!           call GlobalSegMap_init with actual shaped arrays
+!           for non-root processes to satisfy Fortran 90 standard.
+!           See comments in subroutine.
+! 15Feb02 - R. Jacob <jacob@mcs.anl.gov> - use MCT_comm instead of
+!           MP_COMM_WORLD
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname='MCT::m_ExchangeMaps'
+
+! Map Handshaking Parameters:  Map handshaking occurs via 
+! exchange of an array of INTEGER flags. 
+
+  ! Number of Handshaking Parameters; i.e.size of exhcanged parameters array
+
+  integer, parameter :: NumHandshakePars = 4
+
+  ! ComponentIDIndex defines the storage location of the  flag 
+  ! signifying the component number in MCTWorld
+
+  integer, parameter :: ComponentIDIndex = 1
+
+  ! MapTypeIndex defines the storage location in the handshake array 
+  ! of the type of map offered for exchange
+
+  integer, parameter :: MapTypeIndex = 2
+
+          ! NumMapTypes is the number of legitimate MapTypeIndex Values:
+
+  integer, parameter :: NumMapTypes = 2
+
+          ! Recognized MapTypeIndex Values:
+
+  integer, parameter :: GlobalMapFlag = 1
+  integer, parameter :: GlobalSegMapFlag = 2
+
+  ! GsizeIndex defines the location of the grid size (number of points)
+  ! for the map.  This size is 
+
+  integer, parameter :: GsizeIndex = 3
+
+  ! NumSegIndex defines the location of the number of segments in the
+  ! map.  For a GlobalMap, this is the number of processes in the map.
+  ! For a GlobalSegMap, this is the number of global segments (ngseg).
+
+  integer, parameter :: NumSegIndex = 4
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MapHandshake_ - Exchange Map descriptors.
+!
+! !DESCRIPTION:
+! This routine takes input Map descriptors stored in the {\tt INTEGER} 
+! array {\tt LocalMapPars}, the local communicator on which this map is
+! defined ({\tt LocalComm}), and the remote component ID 
+! {\tt RemoteCompID}, and effects an exchange of map descriptors with
+! the remote component, which are returned in the {\tt INTEGER} array
+! {\tt RemoteMapPars}.
+!
+! {\bf N.B.: } The values present in {\tt LocalMapPars} need to be valid
+! only on the root of {\tt LocalComm}.  Likewise, the returned values in
+! {\tt RemoteMapPars} will be valid on the root of {\tt LocalComm}.
+!
+! !INTERFACE:
+
+ subroutine MapHandshake_(LocalMapPars, LocalComm, RemoteCompID, &
+                          RemoteMapPars)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die,      only : MP_perr_die
+      use m_stdio
+      use m_MCTWorld, only : ThisMCTWorld
+      use m_MCTWorld, only : ComponentRootRank
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+!
+      integer, intent(in)  :: LocalMapPars(NumHandshakePars)
+      integer, intent(in)  :: LocalComm
+      integer, intent(in)  :: RemoteCompID
+!
+! !OUTPUT PARAMETERS:
+!
+      integer, intent(out) :: RemoteMapPars(NumHandshakePars)
+
+! !REVISION HISTORY:
+!  6Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 20Apr01 - R.L. Jacob  <jacob@mcs.anl.gov> - add status argument
+!           to MPI_RECV
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MapHandshake_'
+
+  integer :: ierr, myID, RemoteRootID, SendTag, RecvTag
+  integer,dimension(MP_STATUS_SIZE) :: status
+
+  call MP_COMM_RANK(LocalComm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'call MP_COMM_RANK()',ierr)
+
+  RemoteRootID = ComponentRootRank(RemoteCompID, ThisMCTWorld)
+
+  if(myID == 0) then ! I am the root on LocalComm
+
+      ! Compute send/receive tags:
+
+     SendTag = 10 * LocalMapPars(ComponentIDIndex) + RemoteCompID
+     RecvTag = LocalMapPars(ComponentIDIndex) + 10 * RemoteCompID
+
+      ! Post send to RemoteRootID:
+
+     call MPI_SEND(LocalMapPars, NumHandshakePars, MP_INTEGER, &
+	           RemoteRootID, SendTag, ThisMCTWorld%MCT_comm, ierr)
+     if(ierr /= 0) call MP_perr_die(myname_,'call MPI_SEND()',ierr)
+
+      ! Post receive from RemoteRootID:
+
+     call MPI_RECV(RemoteMapPars, NumHandshakePars, MP_INTEGER, &
+	           RemoteRootID, RecvTag, ThisMCTWorld%MCT_comm, status, ierr)
+     if(ierr /= 0) call MP_perr_die(myname_,'call MPI_RECV()',ierr)
+
+  endif ! if(myID == 0)
+
+ end subroutine MapHandshake_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: LoadGlobalMapPars_ - Load GlobalMap descriptors.
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt GlobalMap} variable {\tt Gmap}, and
+! loads its descriptors the output {\tt INTEGER} array {\tt MapPars}.
+! The dimensions of this array, and loading order are all defined in
+! the declaration section of this module.
+!
+! !INTERFACE:
+
+ subroutine LoadGlobalMapPars_(GMap, MapPars)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_comp_id => comp_id
+      use m_GlobalMap, only : GlobalMap_gsize => gsize
+!      use m_GlobalMap, only : GlobalMap_nprocs => nprocs
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+!
+      type(GlobalMap), intent(in)  :: GMap
+!
+! !OUTPUT PARAMETERS: 
+!
+      integer,         intent(out) :: MapPars(NumHandshakePars)
+
+! !REVISION HISTORY:
+!  6Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LoadGlobalMapPars_'
+
+  MapPars(ComponentIDIndex) = GlobalMap_comp_id(GMap)
+  MapPars(MapTypeIndex) = GlobalMapFlag
+  MapPars(GsizeIndex) = GlobalMap_gsize(GMap)
+!  MapPars(NumSegIndex) = GlobalMap_nprocs(GSMap)
+
+ end subroutine LoadGlobalMapPars_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: LoadGlobalSegMapPars_ - Load GlobalSegMap descriptors.
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt GlobalSegMap} variable {\tt Gmap}, and
+! loads its descriptors the output {\tt INTEGER} array {\tt MapPars}.
+! The dimensions of this array, and loading order are all defined in
+! the declaration section of this module.
+!
+! !INTERFACE:
+
+ subroutine LoadGlobalSegMapPars_(GSMap, MapPars)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_id
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+!
+      type(GlobalSegMap), intent(in)  :: GSMap
+!
+! !OUTPUT PARAMETERS: 
+!
+      integer,            intent(out) :: MapPars(NumHandshakePars)
+
+! !REVISION HISTORY:
+!  6Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::LoadGlobalSegMapPars_'
+
+  MapPars(ComponentIDIndex) = GlobalSegMap_comp_id(GSMap)
+  MapPars(MapTypeIndex) = GlobalSegMapFlag
+  MapPars(GsizeIndex) = GlobalSegMap_gsize(GSMap)
+  MapPars(NumSegIndex) = GlobalSegMap_ngseg(GSMap)
+
+ end subroutine LoadGlobalSegMapPars_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ExGSMapGSMap_ - Trade of GlobalSegMap structures.
+!
+! !DESCRIPTION:
+! This routine effects the exchange between two components of their 
+! data decomposition descriptors, each of which is a {\tt GlobalSegMap}.
+! The component invoking this routine provides its domain decomposition 
+! in the form of the input {\tt GlobalSegMap} argument {\tt LocalGSMap}.
+! The component with which map exchange takes place is specified by the 
+! MCT integer component identification number defined by the input 
+! {\tt INTEGER} argument {\tt RemoteCompID}.  The 
+! !INTERFACE:
+
+ subroutine ExGSMapGSMap_(LocalGSMap, LocalComm, RemoteGSMap, &
+                          RemoteCompID, ierr) 
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+
+      use m_MCTWorld, only : ThisMCTWorld
+      use m_MCTWorld, only : ComponentRootRank
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(in)  :: LocalGSMap   ! Local GlobalSegMap
+      integer,            intent(in)  :: LocalComm    ! Local Communicator
+      integer        ,    intent(in)  :: RemoteCompID ! Remote component id
+
+! !OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(out) :: RemoteGSMap ! Remote GlobalSegMap
+      integer,            intent(out) :: ierr        ! Error Flag
+
+! !REVISION HISTORY:
+!  3Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> - First full version.
+! 20Apr01 - R.L. Jacob  <jacob@mcs.anl.gov> - add status argument
+!           to MPI_RECV
+! 25Apr01 - R.L. Jacob  <jacob@mcs.anl.gov> - set SendTag and
+!           RecvTag values
+!  3May01 - R.L. Jacob <jacob@mcs.anl.gov> - change MPI_SEND to
+!           MPI_ISEND to avoid possible buffering problems seen
+!           on IBM SP.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ExGSMapGSMap_'
+
+! root ID on local communicator:
+  integer, parameter :: root = 0
+! Storage for local and remote map descriptors:
+  integer :: LocalMapPars(NumHandshakePars)
+  integer :: RemoteMapPars(NumHandshakePars)
+! Send and Receive Buffers
+  integer, dimension(:), allocatable :: SendBuf
+  integer, dimension(:), allocatable :: RecvBuf
+! Send and Receive Tags
+  integer :: SendTag, RecvTag
+! Storage arrays for Remote GlobalSegMap data:
+  integer, dimension(:), allocatable :: start, length, pe_loc
+
+  integer :: myID, ngseg, remote_root,req
+  integer :: local_ngseg, remote_ngseg
+  integer,dimension(MP_STATUS_SIZE) :: status,wstatus
+
+      ! Determine rank on local communicator:
+
+  call MP_COMM_RANK(LocalComm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'call MP_COMM_RANK()',ierr)
+
+      ! If the root, exchange map handshake descriptors,
+      ! and information needed to initialize the remote map 
+      ! on the local communicator.
+
+  if(myID == root) then
+
+     call LoadGlobalSegMapPars_(LocalGSMap, LocalMapPars)
+
+     call MapHandshake_(LocalMapPars, LocalComm, RemoteCompID, &
+                        RemoteMapPars)
+
+      ! Consistency Checks between LocalMapPars and RemoteMapPars:
+
+     if(LocalMapPars(MapTypeIndex) /= RemoteMapPars(MapTypeIndex)) then
+	ierr = 2
+	write(stderr,*) myname_,":: MCTERROR, Map Type mismatch ", &
+	"LocalMap Type = ",LocalMapPars(MapTypeIndex)," RemoteMap Type = ", &
+	RemoteMapPars(MapTypeIndex)
+	call die(myname_,'Map Type mismatch',ierr)
+     endif
+
+     if(LocalMapPars(GsizeIndex) /= RemoteMapPars(GsizeIndex)) then
+	ierr = 3
+	write(stderr,*) myname_,":: MCTERROR, Grid Size mismatch ", &
+	"LocalMap Gsize = ",LocalMapPars(GsizeIndex)," RemoteMap Gsize = ", &
+	RemoteMapPars(GsizeIndex)
+	call die(myname_,'Map Grid Size mismatch',ierr)
+     endif
+
+     if(RemoteCompID /= RemoteMapPars(ComponentIDIndex)) then
+	ierr = 4
+	write(stderr,*) myname_,":: MCTERROR, Component ID mismatch ", &
+	"RemoteCompID = ",RemoteCompID," RemoteMap CompID = ", &
+	RemoteMapPars(ComponentIDIndex)
+	call die(myname_,'Component ID mismatch',ierr)
+     endif
+
+      ! SendBuf will hold the arrays LocalGSMap%start, LocalGSMap%length,
+      ! and LocalGSMap%pe_loc in that order.
+
+     allocate(SendBuf(3*LocalMapPars(NumSegIndex)), stat=ierr)
+     if(ierr /= 0) call die(myname_,'allocate(SendBuf...)',ierr)
+
+      ! RecvBuf will hold the arrays RemoteGSMap%start, RemoteGSMap%length,
+      ! and RemoteGSMap%pe_loc in that order.
+
+     allocate(RecvBuf(3*RemoteMapPars(NumSegIndex)), stat=ierr)
+     if(ierr /= 0) call die(myname_,'allocate(RecvBuf...)',ierr)
+
+      ! Load SendBuf in the order described above:
+     local_ngseg = LocalMapPars(NumSegIndex)
+     SendBuf(1:local_ngseg) = &
+	                  LocalGSMap%start(1:local_ngseg)
+     SendBuf(local_ngseg+1:2*local_ngseg) = &
+	                  LocalGSMap%length(1:local_ngseg)
+     SendBuf(2*local_ngseg+1:3*local_ngseg) = &
+	                  LocalGSMap%pe_loc(1:local_ngseg)
+
+      ! Determine the remote component root:
+
+     remote_root = ComponentRootRank(RemoteMapPars(ComponentIDIndex), &
+	                             ThisMCTWorld)
+
+     SendTag = 10 * LocalMapPars(ComponentIDIndex) + RemoteCompID
+     RecvTag = LocalMapPars(ComponentIDIndex) + 10 * RemoteCompID
+
+      ! Send off SendBuf to the remote component root:
+
+     call MPI_ISEND(SendBuf(1), 3*LocalMapPars(NumSegIndex), MP_INTEGER, &
+	           remote_root, SendTag, ThisMCTWorld%MCT_comm, req, ierr)
+     if(ierr /= 0) call MP_perr_die(myname_,'MPI_SEND(SendBuf...',ierr)
+
+      ! Receive RecvBuf from the remote component root:
+
+     call MPI_RECV(RecvBuf, 3*RemoteMapPars(NumSegIndex), MP_INTEGER, &
+	           remote_root, RecvTag, ThisMCTWorld%MCT_comm, status, ierr)
+     if(ierr /= 0) call MP_perr_die(myname_,'MPI_Recv(RecvBuf...',ierr)
+
+     call MPI_WAIT(req,wstatus,ierr)
+     if(ierr /= 0) call MP_perr_die(myname_,'MPI_WAIT(SendBuf..',ierr)
+
+      ! Allocate arrays start(:), length(:), and pe_loc(:)
+
+     allocate(start(RemoteMapPars(NumSegIndex)),  &
+	      length(RemoteMapPars(NumSegIndex)), &
+	      pe_loc(RemoteMapPars(NumSegIndex)), stat=ierr)
+     if(ierr /= 0) call die(myname_,'allocate(start...',ierr)
+
+      ! Unpack RecvBuf into arrays start(:), length(:), and pe_loc(:)
+     remote_ngseg = RemoteMapPars(NumSegIndex)
+     start(1:remote_ngseg) = RecvBuf(1:remote_ngseg)
+     length(1:remote_ngseg) = &
+                        RecvBuf(remote_ngseg+1:2*remote_ngseg)
+     pe_loc(1:remote_ngseg) = &
+                        RecvBuf(2*remote_ngseg+1:3*remote_ngseg)
+
+  endif ! if(myID == root)
+
+        ! Non-root processes call GlobalSegMap_init with start, 
+        ! length, and pe_loc, although these arguments are 
+        ! not used in the subroutine. Since these correspond to dummy 
+        ! shaped array arguments in GlobalSegMap_init, the Fortran 90 
+        ! standard dictates that the actual arguments must contain 
+        ! complete shape information. Therefore, these array arguments 
+        ! must be allocated on all processes.
+
+  if(myID /= root) then
+     
+      allocate(start(1), length(1), pe_loc(1), stat=ierr)
+      if(ierr /= 0) call die(myname_,'non-root allocate(start...',ierr)
+
+  endif
+  
+
+      ! Initialize the Remote GlobalSegMap RemoteGSMap
+
+  call GlobalSegMap_init(RemoteGSMap, RemoteMapPars(NumSegIndex), &
+                         start, length, pe_loc, root, LocalComm,  &
+			 RemoteCompID, RemoteMapPars(GsizeIndex))
+
+
+      ! Deallocate allocated arrays
+
+  deallocate(start, length, pe_loc, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,'deallocate(start...',ierr)
+  endif
+
+      ! Deallocate allocated arrays on the root:
+
+  if(myID == root) then
+     
+     deallocate(SendBuf, RecvBuf, stat=ierr)
+     if(ierr /= 0) then
+	call die(myname_,'deallocate(SendBuf...',ierr)
+     endif
+
+  endif ! if(myID == root)
+
+ end subroutine ExGSMapGSMap_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ExGMapGSMap_ - Trade of GlobalMap for GlobalSegMap.
+!
+! !DESCRIPTION:
+! This routine allows a component to report its domain decomposition 
+! using a {\tt GlobalMap} (the input argument {\tt LocalGMap}), and 
+! receive the domain decomposition of a remote component in the form 
+! of a {\tt GlobalSegMap} (the output argument {\tt RemoteGSMap}.  The 
+! component with which map exchange occurs is defined by its component 
+! ID number (the input {\tt INTEGER} argument {\tt RemoteCompID}). 
+! Currently, this operation is implemented as an exchange of maps between
+! the root nodes of each component's communicator, and then propagated 
+! across the local component's communicator.  This requires the user to
+! provide the local communicator (the input {\tt INTEGER} argument 
+! {\tt LocalComm}).  The success (failure) of this operation is reported
+! in the zero (nonzero) value of the output {\tt INTEGER} argument 
+! {\tt ierr}.
+!
+! !INTERFACE:
+
+ subroutine ExGMapGSMap_(LocalGMap, LocalComm, RemoteGSMap, &
+                         RemoteCompID, ierr) 
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      use m_GlobalMap, only : GlobalMap
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+      use m_GlobalSegMap, only : GlobalSegMap_clean => clean
+
+      use m_ConvertMaps, only : GlobalMapToGlobalSegMap
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalMap),    intent(in)  :: LocalGMap    ! Local GlobalMap
+      integer,            intent(in)  :: LocalComm    ! Local Communicator
+      integer,            intent(in)  :: RemoteCompID ! Remote component id
+
+
+! !OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(out) :: RemoteGSMap ! Remote GlobalSegMap
+      integer,            intent(out) :: ierr        ! Error Flag
+
+! !REVISION HISTORY:
+!  3Feb01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 26Sep02 - J.W. Larson <larson@mcs.anl.gov> - Implementation.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ExGMapGSMap_'
+  type(GlobalSegMap) :: LocalGSMap
+
+       ! Convert LocalGMap to a GlobalSegMap
+
+  call GlobalMapToGlobalSegMap(LocalGMap, LocalGSMap)
+
+       ! Exchange local decomposition in GlobalSegMap form with
+       ! the remote component:
+
+  call ExGSMapGSMap_(LocalGSMap, LocalComm, RemoteGSMap, &
+                     RemoteCompID, ierr) 
+
+       ! Destroy LocalGSMap
+
+  call GlobalSegMap_clean(LocalGSMap)
+
+ end subroutine ExGMapGSMap_
+
+ end module m_ExchangeMaps
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGrid.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGrid.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGrid.F90	(revision 4775)
@@ -0,0 +1,3315 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GeneralGrid.F90,v 1.36 2008-05-12 01:57:21 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GeneralGrid -- Physical Coordinate Grid Information Storage
+!
+! !DESCRIPTION:
+! The {\tt GeneralGrid} data type is a flexible, generic structure for 
+! storing physical coordinate grid information.  The {\tt GeneralGrid} 
+! may be employed to store coordinate grids of arbitrary dimension, and 
+! is also capable of supporting unstructured grids such as meteorological 
+! observation data streams.  The grid is representated by a literal 
+! listing of the gridpoint coordinates, along with other integer and real 
+! {\em attributes} associated with each location.  Examples of real 
+! non-coordinate attributes are grid cell length, cross-sectional area, and 
+! volume elements, projections of local directional unit vectors onto 
+! {\em et cetera}  A {\tt GeneralGrid} as at minimum one integer 
+! attribute---{\em the global grid point number}, or {\tt GlobGridNum}, 
+! which serves as a unique identifier for each physical grid location.
+!
+! The real attributes of of the {\tt GeneralGrid} are grouped as {\tt List} 
+! components:
+! \begin{itemize}
+! \item {\tt GGrid\%coordinate\_list} contains the list of the physical 
+! dimension names of the grid.  The user initializes a {\tt List} by 
+! supplying the items in it as a string with the items delimitted by 
+! colons.  For example, setting the coordinates for Euclidean 3-space 
+! is accomplished by a choice of {\tt 'x:y:z'}, cylindrical coordinates 
+! by {\tt 'rho:theta:z'}, spherical coordinates by {\tt 'r:theta:phi'}, 
+! {\em et cetera}.
+! \item {\tt GGrid\%weight\_list} contains the names of the spatial 
+! cell length, area, and volume weights associated with the grid.  These 
+! are also stored in {\tt List} form, and are set by the user in the same
+! fashion as described above for coordinates.  For example, one might 
+! wish create cell weight attributes for a cylindrical grid by defining 
+! a weight list of {\tt 'drho:dphi:rhodphi:dz}.
+! \item {\tt GGrid\%other\_list} is space for the user to define other 
+! real attributes.  For example, one might wish to do vector calculus
+! operatons in spherical coordinates.  Since the spherical coordinate 
+! unit vectors ${\hat r}$, ${\hat \theta}$, and ${\hat \phi}$
+! vary in space, it is sometimes useful to store their projections on 
+! the fixed Euclidean unit vectors ${\bf \hat x}$, ${\bf \hat y}$, and 
+! ${\bf \hat z}$.  To do this one might set up a list of attributes 
+! using the string
+! \begin{verbatim}
+! 'rx:ry:rz:thetax:thetay:thetaz:phix:phiy:phyz'
+! \end{verbatim}
+! \item {\tt GGrid\%index\_list} provides space for the user to define 
+! integer attributes such as alternative indexing schemes, indices for 
+! defining spatial regions, {\em et cetera}.  This attribute list contains
+! all the integer attributes for the {\tt GeneralGrid} save one:  the 
+! with the ever-present {\em global gridpoint number attribute} 
+! {\tt GlobGridNum}, which is set automatically by MCT.
+! \end{itemize}
+!
+! This module contains the definition of the {\tt GeneralGrid} datatype, 
+! various methods for creating and destroying it, query methods, and tools 
+! for multiple-key sorting of gridpoints.
+!
+! !INTERFACE:
+
+ module m_GeneralGrid
+
+!
+! !USES:
+!
+      use m_List, only : List   ! Support for List components.
+
+      use m_AttrVect, only : AttrVect ! Support for AttrVect component.
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC TYPES:
+
+      public :: GeneralGrid      ! The class data structure
+
+    Type GeneralGrid
+#ifdef SEQUENCE
+      sequence
+#endif
+      type(List)                     :: coordinate_list
+      type(List)                     :: coordinate_sort_order
+      logical, dimension(:), pointer :: descend
+      type(List)                     :: weight_list
+      type(List)                     :: other_list
+      type(List)                     :: index_list
+      type(AttrVect)                 :: data
+    End Type GeneralGrid
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init             ! Create a GeneralGrid
+      public :: initCartesian    !
+      public :: initUnstructured !
+      public :: clean            ! Destroy a GeneralGrid
+      public :: zero             ! Zero data in a GeneralGrid
+
+                             ! Query functions-----------------
+      public :: dims         ! Return dimensionality of the GeneralGrid
+      public :: indexIA      ! Index integer attribute (indices)
+      public :: indexRA      ! Index integer attribute (coords/weights)
+      public :: lsize        ! Return local number of points
+      public :: exportIAttr  ! Return INTEGER attribute as a vector
+      public :: exportRAttr  ! Return REAL attribute as a vector
+
+                             ! Manipulation--------------------
+      public :: importIAttr  ! Insert INTEGER vector as attribute
+      public :: importRAttr  ! Insert REAL vector as attribute
+      public :: Sort         ! Sort point data by coordinates -> permutation
+      public :: Permute      ! Rearrange point data using input permutation
+      public :: SortPermute  ! Sort and Permute point data
+
+    interface init  ; module procedure &
+        init_, &
+        initl_, &
+        initgg_
+    end interface
+    interface initCartesian ; module procedure &
+        initCartesianSP_, &
+	initCartesianDP_
+    end interface
+    interface initUnstructured ; module procedure &
+        initUnstructuredSP_, &
+	initUnstructuredDP_
+    end interface
+    interface clean ; module procedure clean_ ; end interface
+    interface zero ; module procedure zero_ ; end interface
+
+    interface dims ; module procedure dims_ ; end interface
+    interface indexIA ; module procedure indexIA_ ; end interface
+    interface indexRA ; module procedure indexRA_ ; end interface
+    interface lsize   ; module procedure lsize_   ; end interface
+
+    interface exportIAttr ; module procedure exportIAttr_ ; end interface
+    interface exportRAttr ; module procedure &
+       exportRAttrSP_, &
+       exportRAttrDP_
+    end interface
+    interface importIAttr ; module procedure importIAttr_ ; end interface
+    interface importRAttr ; module procedure &
+       importRAttrSP_, &
+       importRAttrDP_
+    end interface
+
+    interface Sort    ; module procedure Sort_    ; end interface
+    interface Permute ; module procedure Permute_ ; end interface
+    interface SortPermute ; module procedure SortPermute_ ; end interface
+
+! !PUBLIC DATA MEMBERS:
+
+! CHARACTER Tag for GeneralGrid Global Grid Point Identification Number
+
+  character(len=*), parameter :: GlobGridNum='GlobGridNum'
+
+! !SEE ALSO:
+! The MCT module m_AttrVect and the mpeu module m_List.
+
+! !REVISION HISTORY:
+! 25Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 31Oct00 - J.W. Larson <larson@mcs.anl.gov> - modified the
+!           GeneralGrid type to allow inclusion of grid cell
+!           dimensions (lengths) and area/volume weights.
+! 15Jan01 - J.W. Larson implemented new GeneralGrid type 
+!           definition and added numerous APIs.
+! 17Jan01 - J.W. Larson fixed minor bug in module header use
+!           statement.
+! 19Jan01 - J.W. Larson added other_list and coordinate_sort_order
+!           components to the GeneralGrid type.
+! 21Mar01 - J.W. Larson - deleted the initv_ API (more study
+!           needed before implementation.
+!  2May01 - J.W. Larson - added initgg_ API (replaces old initv_).
+! 13Dec01 - J.W. Larson - added import and export methods.
+! 27Mar02 - J.W. Larson <larson@mcs.anl.gov> - Corrected usage of
+!           m_die routines throughout this module.
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - Modified GeneralGrid usage 
+!           to allow user-defined grid numbering schemes.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_GeneralGrid'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Create an Empty GeneralGrid
+!
+! !DESCRIPTION:
+! The routine {\tt init\_()} creates the storage space for grid point
+! coordinates, area/volume weights, and other coordinate data ({\em e.g.}, 
+! local cell dimensions).  These data are referenced by {\tt List}
+! components that are also created by this routine (see the documentation 
+! of the declaration section of this module for more details about setting 
+! list information).  Each of the input {\tt CHARACTER} arguments is a 
+! colon-delimited string of attribute names, each corrsponding to a 
+! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
+! and are summarized in the table below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|l|l|l|l|}
+!\hline
+!{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
+!\hline
+!{\tt CoordChars} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
+!\hline
+!{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
+! & & Sorting Keys & \\
+!\hline
+!{\tt WeightChars} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
+! & & Length, Area, and & \\
+! & & Volume Weights & \\
+!\hline
+!{\tt OtherChars} & {\tt GGrid\%other\_list} & All Other & No \\
+! & & Real Attributes & \\
+!\hline
+!{\tt IndexChars} & {\tt GGrid\%index\_list} & All Other & No \\
+! & & Integer Attributes & \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! The input {\tt INTEGER} argument {\tt lsize} defines the number of grid points 
+! to be stored in {\tt GGrid}.
+!
+! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder}, 
+! the user can control whether the sorting by each key is in descending or 
+! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.  
+! By default, all sorting is in {\em ascending} order for each key if the 
+! argument {\tt descend} is not provided.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt GGrid} is dynamically
+! allocated memory.  When one no longer needs {\tt GGrid}, one should
+! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
+!
+! !INTERFACE:
+
+ subroutine init_(GGrid, CoordChars, CoordSortOrder, descend, WeightChars, &
+                  OtherChars, IndexChars, lsize )
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_shared => GetSharedListIndices
+      use m_List,     only : List_append => append
+      use m_List,     only : List_copy => copy
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_clean => clean
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*),                intent(in) :: CoordChars
+      character(len=*),      optional, intent(in) :: CoordSortOrder
+      character(len=*),      optional, intent(in) :: WeightChars
+      logical, dimension(:), optional, pointer    :: descend
+      character(len=*),      optional, intent(in) :: OtherChars
+      character(len=*),      optional, intent(in) :: IndexChars
+      integer,               optional, intent(in) :: lsize
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid), intent(out)   :: GGrid
+
+! !REVISION HISTORY:
+! 25Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - modified to fit
+!           new GeneralGrid definition.  
+! 19Mar01 - Jay Larson <larson@mcs.anl.gov> - added OtherChars
+! 25Apr01 - Jay Larson <larson@mcs.anl.gov> - added GlobGridNum
+!           as a mandatory integer attribute.
+! 13Jun01 - Jay Larson <larson@mcs.anl.gov> - No longer define 
+!           blank List attributes of the GeneralGrid.  Previous
+!           versions of this routine had this feature, and this
+!           caused problems with the GeneralGrid Send and Receive
+!           operations on the AIX platform.
+! 13Jun01 - R. Jacob <jacob@mcs.anl.gov> - nullify any pointers
+!           for lists not declared.
+! 15Feb02 - Jay Larson <larson@mcs.anl.gov> - made the input 
+!           argument CoordSortOrder mandatory (rather than
+!           optional).
+! 18Jul02 - E. Ong <eong@mcs.anl.gov> - replaced this version of 
+!           init with one that calls initl_. 
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - made the input argument
+!           CoordSortOrder optional to allow user-defined grid
+!           numbering schemes.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::init_'
+
+  ! List to store real and integer attributes
+  type(List) :: RAList, IAList
+
+  ! Overlapping index storage arrays:
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+
+  ! Temporary vars
+  integer :: NumShared, nitems, i, l, ierr
+
+       ! Let's begin by nullifying everything:
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+        ! Convert the Character arguments to the appropriate
+        ! GeneralGrid components. 
+
+        ! Set up the integer and real attribute lists.
+
+  call List_init(GGrid%coordinate_list,trim(CoordChars))
+  call List_copy(RAList,GGrid%coordinate_list)
+
+  if(present(CoordSortOrder)) then
+     call List_init(GGrid%coordinate_sort_order,trim(CoordSortOrder))
+  endif
+
+  if(present(WeightChars)) then
+     call List_init(GGrid%weight_list,trim(WeightChars))
+     call List_append(RAList, GGrid%weight_list)
+  endif
+
+  if(present(OtherChars)) then
+     call List_init(GGrid%other_list,trim(OtherChars))
+     call List_append(RAList, GGrid%other_list)
+  endif
+
+  call List_init(IAList,GlobGridNum)
+
+  if(present(IndexChars)) then
+     call List_init(GGrid%index_list,trim(IndexChars))
+     call List_append(IAList, GGrid%index_list)
+  endif
+
+        ! Check the lists that we've initialized :
+
+  nitems = List_nitem(GGrid%coordinate_list)
+
+        ! Check the number of coordinates
+
+  if(nitems <= 0) then
+     write(stderr,*) myname_, &
+	  ':: ERROR CoordList is empty!'
+     call die(myname_,'List_nitem(CoordList) <= 0',nitems)
+  endif
+
+        ! Check the items in the coordinate list and the 
+        ! coordinate grid sort keys...they should contain
+        ! the same items.
+
+  if(present(CoordSortOrder)) then
+
+     call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
+	              NumShared,CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= nitems) then
+	call die(myname_,'CoordSortOrder must have the same items &
+	         & as CoordList',abs(nitems-NumShared))
+     endif
+
+  endif
+
+        ! If the LOGICAL argument descend is present, check the
+        ! number of entries to ensure they match the grid dimensionality.
+        ! If descend is not present, assume all coordinate grid point
+        ! sortings will be in ascending order.
+
+  if(present(descend)) then
+
+     if( ( (.not.associated(descend)) .or. &
+	   (.not.present(CoordSortOrder)) ) .or. &
+	   (size(descend) /= nitems) ) then
+	
+	write(stderr,*) myname_, &
+	     ':: ERROR using descend argument, &
+	     &associated(descend) = ', associated(descend), &
+	     ' present(CoordSortOrder) = ', present(CoordSortOrder), &
+	     ' size(descend) = ', size(descend), &
+	     ' List_nitem(CoordSortOrder) = ', &
+             List_nitem(GGrid%coordinate_sort_order)
+	call die(myname_, 'ERROR using -descend- argument; &
+             & see stderr file for details')
+     endif
+
+  endif
+
+       ! Finally, Initialize GGrid%descend from descend(:).
+       ! If descend argument is not present, set it to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(nitems), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+
+        do i=1,nitems
+           GGrid%descend(i) = descend(i)
+        enddo
+
+     else
+
+        do i=1,nitems
+           GGrid%descend(i) = .FALSE.
+        enddo
+
+     endif
+        
+  endif
+  
+       ! Initialize GGrid%data using IAList, RAList, and lsize (if
+       ! present).
+
+  l = 0
+  if(present(lsize)) l=lsize
+
+  call AttrVect_init(GGrid%data, IAList, RAList, l)
+
+
+       ! Deallocate the temporary variables
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+  
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initl_ - Create an Empty GeneralGrid from Lists
+!
+! !DESCRIPTION:
+! The routine {\tt initl\_()} creates the storage space for grid point
+! coordinates, area/volume weights, and other coordinate data ({\em e.g.}, 
+! local cell dimensions).  These data are referenced by {\tt List}
+! components that are also created by this routine (see the documentation 
+! of the declaration section of this module for more details about setting 
+! list information).  Each of the input {\tt List} arguments is used 
+! directly to create the corresponding 
+! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
+! and are summarized in the table below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|l|l|l|l|}
+!\hline
+!{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
+!\hline
+!{\tt CoordList} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
+!\hline
+!{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
+! & & Sorting Keys & \\
+!\hline
+!{\tt WeightList} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
+! & & Length, Area, and & \\
+! & & Volume Weights & \\
+!\hline
+!{\tt OtherList} & {\tt GGrid\%other\_list} & All Other & No \\
+! & & Real Attributes & \\
+!\hline
+!{\tt IndexList} & {\tt GGrid\%index\_list} & All Other & No \\
+! & & Integer Attributes & \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! The input {\tt INTEGER} argument {\tt lsize} defines the number of grid points 
+! to be stored in {\tt GGrid}.
+!
+! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder}, 
+! the user can control whether the sorting by each key is in descending or 
+! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.  
+! By default, all sorting is in {\em ascending} order for each key if the 
+! argument {\tt descend} is not provided.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt GGrid} is dynamically
+! allocated memory.  When one no longer needs {\tt GGrid}, one should
+! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
+!
+! !INTERFACE:
+
+ subroutine initl_(GGrid, CoordList, CoordSortOrder, descend, WeightList, &
+                   OtherList, IndexList, lsize )
+!
+! !USES:
+!
+
+      use m_stdio
+      use m_die
+
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_allocated => allocated
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_shared => GetSharedListIndices
+      use m_List,     only : List_append => append
+      use m_List,     only : List_copy => copy
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_clean => clean
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      Type(List),                      intent(in)  :: CoordList
+      Type(List),            optional, intent(in)  :: CoordSortOrder
+      Type(List),            optional, intent(in)  :: WeightList
+      logical, dimension(:), optional, pointer     :: descend
+      Type(List),            optional, intent(in)  :: OtherList
+      Type(List),            optional, intent(in)  :: IndexList
+      integer,               optional, intent(in)  :: lsize
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid),               intent(out) :: GGrid
+
+! !REVISION HISTORY:
+! 10May01 - Jay Larson <larson@mcs.anl.gov> - initial version
+!  8Aug01 - E.T. Ong <eong@mcs.anl.gov> - changed list assignment(=)
+!           to list copy to avoid compiler bugs with pgf90
+! 17Jul02 - E. Ong <eong@mcs.anl.gov> - general revision; 
+!           added error checks
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - made input argument
+!           CoordSortOrder optional to allow for user-defined
+!           grid numbering schemes
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initl_'
+
+  ! List to store real and integer attributes
+  type(List) :: RAList, IAList
+
+  ! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+
+  ! Temporary vars
+  integer :: NumShared, nitems, i, l, ierr
+
+       ! Let's begin by nullifying everything:
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+        ! Check the arguments:
+
+  nitems = List_nitem(CoordList)
+
+        ! Check the number of coordinates
+
+  if(nitems <= 0) then
+     write(stderr,*) myname_, &
+          ':: ERROR CoordList is empty!'
+     call die(myname_,'List_nitem(CoordList) <= 0',nitems)
+  endif
+
+        ! Check the items in the coordinate list and the 
+        ! coordinate grid sort keys...they should contain
+        ! the same items.
+
+  if(present(CoordSortOrder)) then
+
+     call List_shared(CoordList,CoordSortOrder,NumShared, &
+                      CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= nitems) then
+        call die(myname_,'CoordSortOrder must have the same items &
+                 & as CoordList',abs(nitems-NumShared))
+     endif
+
+  endif
+
+        ! If the LOGICAL argument descend is present, check the
+        ! number of entries to ensure they match the grid dimensionality.
+        ! If descend is not present, assume all coordinate grid point
+        ! sortings will be in ascending order.
+
+  if(present(descend)) then
+
+     if( ( (.not.associated(descend)) .or. &
+           (.not.present(CoordSortOrder)) ) .or. &
+           (size(descend) /= nitems) ) then
+        
+        write(stderr,*) myname_, &
+             ':: ERROR using descend argument, &
+             &associated(descend) = ', associated(descend), &
+             ' present(CoordSortOrder) = ', present(CoordSortOrder), &
+             ' size(descend) = ', size(descend), &
+             ' List_nitem(CoordSortOrder) = ', &
+             List_nitem(CoordSortOrder)
+        call die(myname_, 'ERROR using -descend- argument; &
+             &stderr file for details')
+     endif
+
+  endif
+
+       ! Initialize GGrid%descend from descend(:), if present.  If
+       ! the argument descend(:) was not passed, set GGrid%descend
+       ! to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(nitems), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+
+        do i=1,nitems
+           GGrid%descend(i) = descend(i)
+        enddo
+
+     else
+
+        do i=1,nitems
+           GGrid%descend(i) = .FALSE.
+        enddo
+
+     endif
+
+  endif
+  
+       ! Process input lists and create the appropriate GeneralGrid
+       ! List components
+
+  call List_copy(GGrid%coordinate_list,CoordList)
+  call List_copy(RAList,CoordList)
+
+  if(present(CoordSortOrder)) then
+     if(List_allocated(CoordSortOrder)) then
+        call List_copy(GGrid%coordinate_sort_order,CoordSortOrder)
+     else
+        call die(myname_,"Argument CoortSortOrder not allocated")
+     endif
+  endif
+
+       ! Concatenate present input Lists to create RAList, and
+       ! at the same time assign the List components of GGrid
+
+  if(present(WeightList)) then
+     if(List_allocated(WeightList)) then
+        call List_copy(GGrid%weight_list,WeightList)
+        call List_append(RAList, WeightList)
+     else
+        call die(myname_,"Argument WeightList not allocated")
+     endif
+  endif
+
+  if(present(OtherList)) then
+     if(List_allocated(OtherList)) then
+        call List_copy(GGrid%other_list,OtherList)
+        call List_append(RAList, OtherList)
+     else
+        call die(myname_,"Argument OtherList not allocated")
+     endif
+  endif
+
+       ! Concatenate present input Lists to create IAList
+
+  call List_init(IAList,GlobGridNum)
+
+  if(present(IndexList)) then
+     call List_copy(GGrid%index_list,IndexList)
+     call List_append(IAList, IndexList)
+  endif
+
+       ! Initialize GGrid%data using IAList, RAList, and lsize (if
+       ! present).
+
+  l = 0
+  if(present(lsize)) l = lsize
+
+  call AttrVect_init(GGrid%data, IAList, RAList, l)
+
+       ! Deallocate the temporary variables
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+
+ end subroutine initl_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initgg_ - Create a GeneralGrid from Another
+!
+! !DESCRIPTION:
+! The routine {\tt initgg\_()} creates the storage space for grid point
+! coordinates, area/volume weights, and other coordinate data ({\em e.g.}, 
+! nearest-neighbor coordinates).  These data are all copied from the 
+! already initialized input {\tt GeneralGrid} argument {\tt iGGrid}.  This 
+! routine initializes the output {\tt GeneralGrid} argument {\tt oGGrid} 
+! with the same {\tt List} data as {\tt iGGrid}, but with storage space
+! for {\tt lsize} gridpoints.
+!
+! {\bf N.B.}:  Though the attribute lists and gridpoint sorting strategy 
+! of {\tt iGGrid} is copied to {\tt oGGrid}, the actual values of the 
+! attributes are not.
+!
+! {\bf N.B.}:  It is assumed that {\tt iGGrid} has been initialized.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt oGGrid} is dynamically
+! allocated memory.  When one no longer needs {\tt oGGrid}, one should
+! release this space by invoking {\tt GeneralGrid\_clean()}.
+!
+! !INTERFACE:
+
+ subroutine initgg_(oGGrid, iGGrid, lsize)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+      use m_List, only : List_copy => copy
+      use m_List, only : List_nitems => nitem
+      use m_List, only : List_nullify => nullify
+
+      use m_AttrVect, only:  AttrVect
+      use m_AttrVect, only:  AttrVect_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: iGGrid
+      integer, optional, intent(in)  :: lsize
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid), intent(out) :: oGGrid
+
+! !REVISION HISTORY:
+!  2May01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+! 13Jun01 - Jay Larson <larson@mcs.anl.gov> - Now, undefined List
+!           components of the GeneralGrid iGGrid are no longer 
+!           copied to oGGrid.
+!  8Aug01 - E.T. Ong <eong@mcs.anl.gov> - changed list assignment(=)
+!           to list copy to avoid compiler bugs with pgf90
+! 24Jul02 - E.T. Ong <eong@mcs.anl.gov> - updated this init version
+!           to correspond with initl_
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - made input argument
+!           CoordSortOrder optional to allow for user-defined
+!           grid numbering schemes
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initgg_'
+! Number of grid points, number of grid dimensions
+  integer :: n, ncoord, norder
+! Loop index and Error Flag
+  integer :: i, ierr
+
+       ! Start by nullifying everything:
+
+  call List_nullify(oGGrid%coordinate_list)
+  call List_nullify(oGGrid%coordinate_sort_order)
+  call List_nullify(oGGrid%weight_list)
+  call List_nullify(oGGrid%other_list)
+  call List_nullify(oGGrid%index_list)
+  nullify(oGGrid%descend)
+
+        ! Brief argument check:
+        
+  ncoord = dims_(iGGrid)    ! dimensionality of the GeneralGrid
+  
+  if(associated(iGGrid%descend)) then
+
+     if(size(iGGrid%descend) /= ncoord) then ! size mismatch
+	call die(myname_,"size(iGGrid%descend) must equal ncoord, &
+	         & size(iGGrid%descend) = ", size(iGGrid%descend), &
+                 "ncoord = ", ncoord )
+     endif
+
+  endif
+
+        ! If iGGrid%descend has been allocated, copy its contents;
+        ! allocate and fill oGGrid%descend
+
+  if(associated(iGGrid%descend)) then
+
+     allocate(oGGrid%descend(ncoord), stat=ierr)
+     if(ierr /= 0) then
+	call die(myname_,"allocate(oGGrid%descend...", ierr)
+     endif
+
+     do i=1,ncoord
+	oGGrid%descend(i) = iGGrid%descend(i)
+     end do
+
+  endif
+
+       ! Copy list data from iGGrid to oGGrid. 
+
+  call List_copy(oGGrid%coordinate_list,iGGrid%coordinate_list)
+  if(List_allocated(iGGrid%coordinate_sort_order)) then
+     call List_copy(oGGrid%coordinate_sort_order,iGGrid%coordinate_sort_order)
+  endif
+  if(List_allocated(iGGrid%weight_list)) then
+     call List_copy(oGGrid%weight_list,iGGrid%weight_list)
+  endif
+  if(List_allocated(iGGrid%other_list)) then
+     call List_copy(oGGrid%other_list,iGGrid%other_list)
+  endif
+  if(List_allocated(iGGrid%index_list)) then
+     call List_copy(oGGrid%index_list,iGGrid%index_list)
+  endif
+
+        ! if lsize is present, use it to set n; if not, set n=0
+
+  n = 0
+  if(present(lsize)) n=lsize
+
+       ! Now, initialize oGGrid%data from iGGrid%data, but 
+       ! with length n.
+
+  call AttrVect_init(oGGrid%data, iGGrid%data, n)
+
+ end subroutine initgg_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initCartesianSP_ - Initialize a Cartesian GeneralGrid
+!
+! !DESCRIPTION:
+! The routine {\tt initCartesian\_()} creates the storage space for grid point
+! coordinates, area and volume weights, and other coordinate data ({\em e.g.}, 
+! cell area and volume weights).  The names of the Cartesian axes are supplied
+! by the user as a colon-delimitted string in the input {\tt CHARACTER}
+! argument {\tt CoordChars}.  For example, a Cartesian grid for Euclidian
+! 3-space would have ${\tt CoordChars} = {\tt 'x:y:z'}$.  The user can 
+! define named real attributes for spatial weighting data in the input 
+! {\tt CHARACTER} argument {\tt WeightChars}.  For example, one could 
+! define attributes for Euclidean 3-space length elements by setting 
+! ${\tt WeightChars} = {\tt 'dx:dy:dz'}$.  The input {\tt CHARCTER} 
+! argument {\tt OtherChars} provides space for defining other real 
+! attributes (again as a colon-delimited string of attribute names).
+! One can define integer attributes by supplying a colon-delimitted 
+! string of names in the input {\tt CHARACTER} argument 
+! {\tt IndexChars}.  For example, on could set aside storage space 
+! for the {\tt x}-, {\tt y}-, and {\tt z}-indices by setting 
+! ${\tt IndexChars} = {\tt 'xIndex:yIndex:zIndex'}$.
+!
+! Once the storage space in {\tt GGrid} is initialized, The gridpoint 
+! coordinates are evaluated using the input arguments {\tt Dims} (the 
+! number of points on each coordinate axis) and {\tt AxisData} (the 
+! coordinate values on all of the points of all of the axes).  The user 
+! presents the axes with each axis stored in a column of {\tt AxisData},
+! and the axes are laid out in the same order as the ordering of the 
+! axis names in {\tt CoordChars}.  The number of points on each axis 
+! is defined by the entries of the input {\tt INTEGER} array 
+! {\tt Dims(:)}.  Continuing with the Euclidean 3-space example given 
+! above, setting ${\tt Dims(1:3)} = {\tt (256, 256, 128)}$ will result 
+! in a Cartesian grid with 256 points in the {\tt x}- and {\tt y}-directions,
+! and 128 points in the {\tt z}-direction.  Thus the appropriate dimensions 
+! of {\tt AxisData} are 256 rows (the maximum number of axis points among
+! all the axes) by 3 columns (the number of physical dimensions).  The 
+! {\tt x}-axis points are stored in {\tt AxisData(1:256,1)}, the 
+! {\tt y}-axis points are stored in {\tt AxisData(1:256,2)}, and the 
+! {\tt z}-axis points are stored in {\tt AxisData(1:128,3)}.
+!
+! The sorting order of the gridpoints can be either user-defined, or 
+! set automatically by MCT.  If the latter is desired, the user must 
+! supply the argument {\tt CoordSortOrder}, which defines the 
+! lexicographic ordering (by coordinate).  The entries optional input 
+! {\tt LOGICAL} array {\tt descend(:)} stipulates whether the ordering 
+! with respect to the corresponding key in {\tt CoordChars} is to be
+! {\em descending}.  If {\tt CoordChars} is supplied, but {\tt descend(:)} 
+! is not, the gridpoint information is placed in {\em ascending} order 
+! for each key.  Returning to our Euclidian 3-space example, a choice of  
+! ${\tt CoordSortOrder} = {\tt y:x:z}$ and ${\tt descend(1:3)} = 
+! ({\tt .TRUE.}, {\tt .FALSE.}, {\tt .FALSE.})$ will result in the entries of 
+! {\tt GGrid} being orderd lexicographically by {\tt y} (in descending 
+! order), {\tt x} (in ascending order), and {\tt z} (in ascending order).
+! Regardless of the gridpoint sorting strategy, MCT will number each of 
+! the gridpoints in {\tt GGrid}, storing this information in the integer 
+! attribute named {\tt 'GlobGridNum'}.
+!
+! !INTERFACE:
+
+ subroutine initCartesianSP_(GGrid, CoordChars, CoordSortOrder, descend, &
+                           WeightChars, OtherChars, IndexChars, Dims, &
+                           AxisData)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_realkinds,  only : SP
+
+      use m_String,     only : String
+      use m_String,     only : String_ToChar => ToChar
+      use m_String,     only : String_clean => clean
+
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_clean => clean
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_append => append
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_get => get
+      use m_List,     only : List_shared => GetSharedListIndices
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*),                  intent(in)  :: CoordChars
+      character(len=*),        optional, intent(in)  :: CoordSortOrder
+      character(len=*),        optional, intent(in)  :: WeightChars
+      logical, dimension(:),   optional, pointer     :: descend
+      character(len=*),        optional, intent(in)  :: OtherChars
+      character(len=*),        optional, intent(in)  :: IndexChars
+      integer, dimension(:),             pointer     :: Dims
+      real(SP), dimension(:,:),          pointer     :: AxisData
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid),                 intent(out) :: GGrid
+
+! !REVISION HISTORY:
+!  7Jun01 - Jay Larson <larson@mcs.anl.gov> - API Specification.
+! 12Aug02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initCartesianSP_'
+
+  type(List) :: IAList, RAList
+  type(String) :: AxisName
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+  integer :: DimMax, NumDims, NumGridPoints, NumShared
+  integer :: ierr, iAxis, i, j, k, n, nCycles, nRepeat
+  integer :: index
+
+       ! Nullify GeneralGrid components
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+       ! Sanity check on axis definition arguments:
+
+       ! Ensure each axis has a positive number of points, and
+       ! determine DimMax, the maximum entry in Dims(:).
+
+  DimMax = 1
+  do i=1,size(Dims)
+     if(Dims(i) > DimMax) DimMax = Dims(i)
+     if(Dims(i) <= 0) then
+	write(stderr,'(2a,i8,a,i8)') myname_, &
+	     ':: FATAL--illegal number of axis points in Dims(',i,') = ', &
+	     Dims(i)
+	call die(myname_)
+     endif
+  end do
+
+       ! Are the definitions of Dims(:) and AxisData(:,:) compatible?
+       ! The number of elements in Dims(:) should match the number of
+       ! columns in AxisData(:,:), and the maximum value stored in Dims(:) 
+       ! (DimMax determined above in this routine) must not exceed the 
+       ! number of rows in AxisData(:,:).
+
+  if(size(AxisData,2) /= size(Dims)) then
+     write(stderr,'(4a,i8,a,i8)') myname_, &
+	  ':: FATAL-- The number of axes (elements) referenced in Dims(:) ', &
+	  'does not equal the number of columns in AxisData(:,:).  ', &
+	  'size(Dims) = ',size(Dims),' size(AxisData,2) = ',size(AxisData,2)
+     call die(myname_)
+  endif
+
+  if(size(AxisData,1) < DimMax) then
+     write(stderr,'(4a,i8,a,i8)') myname_, &
+	  ':: FATAL-- Maximum number of axis points max(Dims) is ', &
+	  'greater than the number of rows in AxisData(:,:).  ', &
+	  'max(Dims) = ',DimMax,' size(AxisData,1) = ',size(AxisData,1)
+     call die(myname_)
+  endif
+
+       ! If the LOGICAL descend(:) flags for sorting are present, 
+       ! make sure that (1) descend is associated, and 
+       ! (2) CoordSortOrder is also present, and 
+       ! (3) The size of descend(:) matches the size of Dims(:),
+       ! both of which correspond to the number of axes on the 
+       ! Cartesian Grid.
+
+  if(present(descend)) then
+
+     if(.not.associated(descend)) then
+        call die(myname_,'descend argument must be associated')
+     endif
+
+     if(.not. present(CoordSortOrder)) then
+        write(stderr,'(4a)') myname_, &
+             ':: FATAL -- Invocation with the argument descend(:) present ', &
+             'requires the presence of the argument CoordSortOrder, ', &
+             'which was not provided.'
+        call die(myname_, 'Argument CoordSortOrder was not provided')
+     endif
+
+     if(size(descend) /= size(Dims)) then
+	write(stderr,'(4a,i8,a,i8)') myname_, &
+	     ':: FATAL-- The sizes of the arrays descend(:) and Dims(:) ', &
+	     'must match (they both must equal the number of dimensions ', &
+	     'of the Cartesian Grid).  size(Dims) = ',size(Dims), &
+	     ' size(descend) = ',size(descend)
+	call die(myname_,'size of <descend> and <Dims> arguments must match')
+     endif
+
+  endif
+
+       ! Initialize GGrid%coordinate_list and use the number of items 
+       ! in it to set the number of dimensions of the Cartesian 
+       ! Grid (NumDims):
+
+  call List_init(GGrid%coordinate_list, CoordChars)
+  
+  NumDims = List_nitem(GGrid%coordinate_list)
+
+       ! Check the number of arguments
+
+  if(NumDims <= 0) then
+     write(stderr,*) myname_, &
+	  ':: ERROR CoordList is empty!'
+     call die(myname_,'List_nitem(CoordList) <= 0',NumDims)
+  endif
+
+       ! Do the number of coordinate names specified match the number
+       ! of coordinate axes (i.e., the number of columns in AxisData(:,:))?
+
+  if(NumDims /= size(AxisData,2)) then
+     write(stderr,'(6a,i8,a,i8)') myname_, &
+	  ':: FATAL-- Number of axes specified in argument CoordChars ', &
+	  'does not equal the number of axes stored in AxisData(:,:).  ', &
+	  'CoordChars = ', CoordChars, &
+	  'Number of axes = ',NumDims, &
+	  ' size(AxisData,2) = ',size(AxisData,2)
+     call die(myname_)
+  endif
+
+       ! End of argument sanity checks.
+
+       ! Create other List components of GGrid and build REAL
+       ! and INTEGER attribute lists for the AttrVect GGrid%data
+
+       ! Start off with things *guaranteed* to be in IAList and RAList.
+       ! The variable GlobGridNum is a CHARACTER parameter inherited 
+       ! from the declaration section of this module.
+
+  call List_init(IAList, GlobGridNum)
+  call List_init(RAList, CoordChars)
+
+  if(present(CoordSortOrder)) then
+
+     call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
+
+        ! Check the items in the coordinate list and the 
+        ! coordinate grid sort keys...they should contain
+        ! the same items.
+
+     call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
+	              NumShared,CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= NumDims) then
+	call die(myname_,'CoordSortOrder must have the same items &
+	         & as CoordList',abs(NumDims-NumShared))
+     endif
+
+  endif
+
+  if(present(WeightChars)) then
+     call List_init(GGrid%weight_list, WeightChars)
+     call List_append(RAList, GGrid%weight_list)
+  endif
+
+  if(present(OtherChars)) then
+     call List_init(GGrid%other_list, OtherChars)
+     call List_append(RAList, GGrid%other_list)
+  endif
+
+  if(present(IndexChars)) then
+     call List_init(GGrid%index_list, IndexChars)
+     call List_append(IAList, GGrid%index_list)
+  endif
+
+       ! Finally, Initialize GGrid%descend from descend(:).
+       ! If descend argument is not present, set it to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(NumDims), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+        do n=1,NumDims
+           GGrid%descend(n) = descend(n)
+        end do
+     else
+        do n=1,NumDims
+           GGrid%descend(n) = .FALSE.
+        end do
+     endif
+        
+  endif ! if(present(CoordSortOrder))...
+  
+       ! Compute the total number of grid points in the GeneralGrid.
+       ! This is merely the product of the elements of Dims(:)
+
+  NumGridPoints = 1
+  do i=1,NumDims
+     NumGridPoints = NumGridPoints * Dims(i)
+  end do
+
+       ! Now we are prepared to create GGrid%data:
+
+  call AttrVect_init(GGrid%data, IAList, RAList, NumGridPoints)
+  call AttrVect_zero(GGrid%data)
+
+       ! Now, store Cartesian gridpoint data, in the order
+       ! defined by how the user laid out AxisData(:,:)
+
+  do n=1,NumDims
+
+       ! Retrieve first coordinate axis name from GGrid%coordinate_list 
+       ! (as a String)
+     call List_get(AxisName, n, GGrid%coordinate_list)
+
+       ! Index this real attribute of GGrid
+     iAxis = indexRA_(GGrid, String_ToChar(AxisName))
+
+     if(iAxis <= 0) then
+	write(stderr,'(4a)') myname_, &
+	     ':: REAL Attribute "',String_ToChar(AxisName),'" not found.'
+	call die(myname_)
+     endif
+
+       ! Now, clear the String AxisName for use in the next 
+       ! cycle of this loop:
+
+     call String_clean(AxisName)
+
+       ! Compute the number of times we cycle through the axis 
+       ! values (nCycles), and the number of times each axis 
+       ! value is repeated in each cycle (nRepeat)
+
+     nCycles = 1
+     if(n > 1) then
+	do i=1,n-1
+	   nCycles = nCycles * Dims(i)
+	end do
+     endif
+
+     nRepeat = 1
+     if(n < NumDims) then
+	do i=n+1,NumDims
+	   nRepeat = nRepeat * Dims(i)
+	end do
+     endif
+
+       ! Loop over the number of cycles for which we run through
+       ! all the axis points.  Within each cycle, loop over all
+       ! of the axis points, repeating each value nRepeat times.
+       ! This produces a set of grid entries that are in 
+       ! lexicographic order with respect to how the axes are
+       ! presented to this routine.
+
+     index = 1
+     do i=1,nCycles
+	do j=1,Dims(n)
+	   do k=1,nRepeat
+	      GGrid%data%rAttr(iAxis,index) = AxisData(j,n)
+	      index = index+1
+	   end do ! do k=1,nRepeat
+	end do ! do j=1,Dims(n)
+     end do ! do i=1,nCycles
+
+  end do ! do n=1,NumDims...
+
+       ! If the argument CoordSortOrder was supplied, the entries
+       ! of GGrid will be sorted/permuted with this lexicographic
+       ! ordering, and the values of the GGrid INTEGER attribute 
+       ! GlobGridNum will be numbered to reflect this new ordering
+       ! scheme.
+
+  index = indexIA_(GGrid, GlobGridNum)
+
+  if(present(CoordSortOrder)) then ! Sort permute entries before
+                                   ! numbering them
+
+     call SortPermute_(GGrid) ! Sort / permute
+
+  endif ! if(present(CoordSortOrder))...
+
+       ! Number the gridpoints based on the AttrVect point index
+       ! (i.e., the second index in GGrid%data%iAttr)
+
+  do i=1, lsize_(GGrid)
+     GGrid%data%iAttr(index,i) = i
+  end do
+
+       ! Finally, clean up intermediate Lists
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+
+ end subroutine initCartesianSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: initCartesianDP_ - Initialize a Cartesian GeneralGrid
+!
+! !DESCRIPTION:
+! Double Precision version of initCartesianSP_
+!
+! !INTERFACE:
+
+ subroutine initCartesianDP_(GGrid, CoordChars, CoordSortOrder, descend, &
+                           WeightChars, OtherChars, IndexChars, Dims, &
+                           AxisData)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_realkinds,  only : DP
+
+      use m_String,     only : String
+      use m_String,     only : String_ToChar => ToChar
+      use m_String,     only : String_clean => clean
+
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_clean => clean
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_append => append
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_get => get
+      use m_List,     only : List_shared => GetSharedListIndices
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*),                  intent(in)  :: CoordChars
+      character(len=*),        optional, intent(in)  :: CoordSortOrder
+      character(len=*),        optional, intent(in)  :: WeightChars
+      logical, dimension(:),   optional, pointer     :: descend
+      character(len=*),        optional, intent(in)  :: OtherChars
+      character(len=*),        optional, intent(in)  :: IndexChars
+      integer, dimension(:),             pointer     :: Dims
+      real(DP), dimension(:,:),          pointer     :: AxisData
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid),                 intent(out) :: GGrid
+
+! !REVISION HISTORY:
+!  7Jun01 - Jay Larson <larson@mcs.anl.gov> - API Specification.
+! 12Aug02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+! ______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initCartesianDP_'
+
+  type(List) :: IAList, RAList
+  type(String) :: AxisName
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+  integer :: DimMax, NumDims, NumGridPoints, NumShared
+  integer :: ierr, iAxis, i, j, k, n, nCycles, nRepeat
+  integer :: index
+
+       ! Nullify GeneralGrid components
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+       ! Sanity check on axis definition arguments:
+
+       ! Ensure each axis has a positive number of points, and
+       ! determine DimMax, the maximum entry in Dims(:).
+
+  DimMax = 1
+  do i=1,size(Dims)
+     if(Dims(i) > DimMax) DimMax = Dims(i)
+     if(Dims(i) <= 0) then
+	write(stderr,'(2a,i8,a,i8)') myname_, &
+	     ':: FATAL--illegal number of axis points in Dims(',i,') = ', &
+	     Dims(i)
+	call die(myname_)
+     endif
+  end do
+
+       ! Are the definitions of Dims(:) and AxisData(:,:) compatible?
+       ! The number of elements in Dims(:) should match the number of
+       ! columns in AxisData(:,:), and the maximum value stored in Dims(:) 
+       ! (DimMax determined above in this routine) must not exceed the 
+       ! number of rows in AxisData(:,:).
+
+  if(size(AxisData,2) /= size(Dims)) then
+     write(stderr,'(4a,i8,a,i8)') myname_, &
+	  ':: FATAL-- The number of axes (elements) referenced in Dims(:) ', &
+	  'does not equal the number of columns in AxisData(:,:).  ', &
+	  'size(Dims) = ',size(Dims),' size(AxisData,2) = ',size(AxisData,2)
+     call die(myname_)
+  endif
+
+  if(size(AxisData,1) < DimMax) then
+     write(stderr,'(4a,i8,a,i8)') myname_, &
+	  ':: FATAL-- Maximum number of axis points max(Dims) is ', &
+	  'greater than the number of rows in AxisData(:,:).  ', &
+	  'max(Dims) = ',DimMax,' size(AxisData,1) = ',size(AxisData,1)
+     call die(myname_)
+  endif
+
+       ! If the LOGICAL descend(:) flags for sorting are present, 
+       ! make sure that (1) descend is associated, and 
+       ! (2) CoordSortOrder is also present, and 
+       ! (3) The size of descend(:) matches the size of Dims(:),
+       ! both of which correspond to the number of axes on the 
+       ! Cartesian Grid.
+
+  if(present(descend)) then
+
+     if(.not.associated(descend)) then
+        call die(myname_,'descend argument must be associated')
+     endif
+
+     if(.not. present(CoordSortOrder)) then
+        write(stderr,'(4a)') myname_, &
+             ':: FATAL -- Invocation with the argument descend(:) present ', &
+             'requires the presence of the argument CoordSortOrder, ', &
+             'which was not provided.'
+        call die(myname_, 'Argument CoordSortOrder was not provided')
+     endif
+
+     if(size(descend) /= size(Dims)) then
+	write(stderr,'(4a,i8,a,i8)') myname_, &
+	     ':: FATAL-- The sizes of the arrays descend(:) and Dims(:) ', &
+	     'must match (they both must equal the number of dimensions ', &
+	     'of the Cartesian Grid).  size(Dims) = ',size(Dims), &
+	     ' size(descend) = ',size(descend)
+	call die(myname_,'size of <descend> and <Dims> arguments must match')
+     endif
+
+  endif
+
+       ! Initialize GGrid%coordinate_list and use the number of items 
+       ! in it to set the number of dimensions of the Cartesian 
+       ! Grid (NumDims):
+
+  call List_init(GGrid%coordinate_list, CoordChars)
+  
+  NumDims = List_nitem(GGrid%coordinate_list)
+
+       ! Check the number of arguments
+
+  if(NumDims <= 0) then
+     write(stderr,*) myname_, &
+	  ':: ERROR CoordList is empty!'
+     call die(myname_,'List_nitem(CoordList) <= 0',NumDims)
+  endif
+
+       ! Do the number of coordinate names specified match the number
+       ! of coordinate axes (i.e., the number of columns in AxisData(:,:))?
+
+  if(NumDims /= size(AxisData,2)) then
+     write(stderr,'(6a,i8,a,i8)') myname_, &
+	  ':: FATAL-- Number of axes specified in argument CoordChars ', &
+	  'does not equal the number of axes stored in AxisData(:,:).  ', &
+	  'CoordChars = ', CoordChars, &
+	  'Number of axes = ',NumDims, &
+	  ' size(AxisData,2) = ',size(AxisData,2)
+     call die(myname_)
+  endif
+
+       ! End of argument sanity checks.
+
+       ! Create other List components of GGrid and build REAL
+       ! and INTEGER attribute lists for the AttrVect GGrid%data
+
+       ! Start off with things *guaranteed* to be in IAList and RAList.
+       ! The variable GlobGridNum is a CHARACTER parameter inherited 
+       ! from the declaration section of this module.
+
+  call List_init(IAList, GlobGridNum)
+  call List_init(RAList, CoordChars)
+
+  if(present(CoordSortOrder)) then
+
+     call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
+
+        ! Check the items in the coordinate list and the 
+        ! coordinate grid sort keys...they should contain
+        ! the same items.
+
+     call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
+	              NumShared,CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= NumDims) then
+	call die(myname_,'CoordSortOrder must have the same items &
+	         & as CoordList',abs(NumDims-NumShared))
+     endif
+
+  endif
+
+  if(present(WeightChars)) then
+     call List_init(GGrid%weight_list, WeightChars)
+     call List_append(RAList, GGrid%weight_list)
+  endif
+
+  if(present(OtherChars)) then
+     call List_init(GGrid%other_list, OtherChars)
+     call List_append(RAList, GGrid%other_list)
+  endif
+
+  if(present(IndexChars)) then
+     call List_init(GGrid%index_list, IndexChars)
+     call List_append(IAList, GGrid%index_list)
+  endif
+
+       ! Finally, Initialize GGrid%descend from descend(:).
+       ! If descend argument is not present, set it to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(NumDims), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+        do n=1,NumDims
+           GGrid%descend(n) = descend(n)
+        end do
+     else
+        do n=1,NumDims
+           GGrid%descend(n) = .FALSE.
+        end do
+     endif
+        
+  endif ! if(present(CoordSortOrder))...
+  
+       ! Compute the total number of grid points in the GeneralGrid.
+       ! This is merely the product of the elements of Dims(:)
+
+  NumGridPoints = 1
+  do i=1,NumDims
+     NumGridPoints = NumGridPoints * Dims(i)
+  end do
+
+       ! Now we are prepared to create GGrid%data:
+
+  call AttrVect_init(GGrid%data, IAList, RAList, NumGridPoints)
+  call AttrVect_zero(GGrid%data)
+
+       ! Now, store Cartesian gridpoint data, in the order
+       ! defined by how the user laid out AxisData(:,:)
+
+  do n=1,NumDims
+
+       ! Retrieve first coordinate axis name from GGrid%coordinate_list 
+       ! (as a String)
+     call List_get(AxisName, n, GGrid%coordinate_list)
+
+       ! Index this real attribute of GGrid
+     iAxis = indexRA_(GGrid, String_ToChar(AxisName))
+
+     if(iAxis <= 0) then
+	write(stderr,'(4a)') myname_, &
+	     ':: REAL Attribute "',String_ToChar(AxisName),'" not found.'
+	call die(myname_)
+     endif
+
+       ! Now, clear the String AxisName for use in the next 
+       ! cycle of this loop:
+
+     call String_clean(AxisName)
+
+       ! Compute the number of times we cycle through the axis 
+       ! values (nCycles), and the number of times each axis 
+       ! value is repeated in each cycle (nRepeat)
+
+     nCycles = 1
+     if(n > 1) then
+	do i=1,n-1
+	   nCycles = nCycles * Dims(i)
+	end do
+     endif
+
+     nRepeat = 1
+     if(n < NumDims) then
+	do i=n+1,NumDims
+	   nRepeat = nRepeat * Dims(i)
+	end do
+     endif
+
+       ! Loop over the number of cycles for which we run through
+       ! all the axis points.  Within each cycle, loop over all
+       ! of the axis points, repeating each value nRepeat times.
+       ! This produces a set of grid entries that are in 
+       ! lexicographic order with respect to how the axes are
+       ! presented to this routine.
+
+     index = 1
+     do i=1,nCycles
+	do j=1,Dims(n)
+	   do k=1,nRepeat
+	      GGrid%data%rAttr(iAxis,index) = AxisData(j,n)
+	      index = index+1
+	   end do ! do k=1,nRepeat
+	end do ! do j=1,Dims(n)
+     end do ! do i=1,nCycles
+
+  end do ! do n=1,NumDims...
+
+       ! If the argument CoordSortOrder was supplied, the entries
+       ! of GGrid will be sorted/permuted with this lexicographic
+       ! ordering, and the values of the GGrid INTEGER attribute 
+       ! GlobGridNum will be numbered to reflect this new ordering
+       ! scheme.
+
+  index = indexIA_(GGrid, GlobGridNum)
+
+  if(present(CoordSortOrder)) then ! Sort permute entries before
+                                   ! numbering them
+
+     call SortPermute_(GGrid) ! Sort / permute
+
+  endif ! if(present(CoordSortOrder))...
+
+       ! Number the gridpoints based on the AttrVect point index
+       ! (i.e., the second index in GGrid%data%iAttr)
+
+  do i=1, lsize_(GGrid)
+     GGrid%data%iAttr(index,i) = i
+  end do
+
+       ! Finally, clean up intermediate Lists
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+
+ end subroutine initCartesianDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initUnstructuredSP_ - Initialize an Unstructured GeneralGrid
+!
+! !DESCRIPTION:
+! This routine creates the storage space for grid point
+! coordinates, area/volume weights, and other coordinate data ({\em e.g.}, 
+! local cell dimensions), and fills in user-supplied values for the grid 
+! point coordinates.  These data are referenced by {\tt List}
+! components that are also created by this routine (see the documentation 
+! of the declaration section of this module for more details about setting 
+! list information).  Each of the input {\tt CHARACTER} arguments is a 
+! colon-delimited string of attribute names, each corrsponding to a 
+! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
+! and are summarized in the table below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|l|l|l|l|}
+!\hline
+!{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
+!\hline
+!{\tt CoordChars} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
+!\hline
+!{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
+! & & Sorting Keys & \\
+!\hline
+!{\tt WeightChars} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
+! & & Length, Area, and & \\
+! & & Volume Weights & \\
+!\hline
+!{\tt OtherChars} & {\tt GGrid\%other\_list} & All Other & No \\
+! & & Real Attributes & \\
+!\hline
+!{\tt IndexChars} & {\tt GGrid\%index\_list} & All Other & No \\
+! & & Integer Attributes & \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! The number of physical dimensions of the grid is set by the user in 
+! the input {\tt INTEGER} argument {\tt nDims}, and the number of grid 
+! points stored in {\tt GGrid} is set using the input {\tt INTEGER} 
+! argument {\tt nPoints}.  The grid point coordinates are input via the 
+! {\tt REAL} array {\tt PointData(:)}.  The number of entries in 
+! {\tt PointData} must equal the product of {\tt nDims} and {\tt nPoints}.
+! The grid points are grouped in {\tt nPoints} consecutive groups of 
+! {\tt nDims} entries, with the coordinate values for each point set in 
+! the same order as the dimensions are named in the list {\tt CoordChars}.
+!
+! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder}, 
+! the user can control whether the sorting by each key is in descending or 
+! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.  
+! By default, all sorting is in {\em ascending} order for each key if the 
+! argument {\tt descend} is not provided.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt GGrid} is dynamically
+! allocated memory.  When one no longer needs {\tt GGrid}, one should
+! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
+!
+! !INTERFACE:
+
+ subroutine initUnstructuredSP_(GGrid, CoordChars, CoordSortOrder, descend, &
+                              WeightChars, OtherChars, IndexChars, nDims, &
+                              nPoints, PointData)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_realkinds,only : SP
+
+      use m_String,   only : String, char
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_clean => clean
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_copy => copy
+      use m_List,     only : List_append => append
+      use m_List,     only : List_shared => GetSharedListIndices
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*),             intent(in) :: CoordChars
+      character(len=*), optional,   intent(in) :: CoordSortOrder
+      character(len=*), optional,   intent(in) :: WeightChars
+      logical, dimension(:), optional, pointer :: descend
+      character(len=*), optional,   intent(in) :: OtherChars
+      character(len=*), optional,   intent(in) :: IndexChars
+      integer,                      intent(in) :: nDims
+      integer,                      intent(in) :: nPoints
+      real(SP), dimension(:),       pointer    :: PointData
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid), intent(out)   :: GGrid
+
+! !REVISION HISTORY:
+!  7Jun01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 22Aug02 - J. Larson <larson@mcs.anl.gov> - Implementation.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initUnstructuredSP_'
+
+  integer :: i, ierr, index, n, nOffSet, NumShared
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+  type(List) :: IAList, RAList
+
+       ! Nullify all GeneralGrid components
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+       ! Sanity checks on input arguments:
+
+       ! If the LOGICAL descend(:) flags for sorting are present, 
+       ! make sure that (1) it is associated, 
+       ! (2) CoordSortOrder is also present, and 
+       ! (3) The size of descend(:) matches the size of Dims(:),
+       ! both of which correspond to the number of axes on the 
+       ! Cartesian Grid.
+
+  if(present(descend)) then
+
+     if(.not.associated(descend)) then
+        call die(myname_,'descend argument must be associated')
+     endif
+
+     if(.not. present(CoordSortOrder)) then
+        write(stderr,'(4a)') myname_, &
+             ':: FATAL -- Invocation with the argument descend(:) present ', &
+             'requires the presence of the argument CoordSortOrder, ', &
+             'which was not provided.'
+        call die(myname_,'Argument CoordSortOrder was not provided')
+     endif
+
+     if(present(descend)) then
+        if(size(descend) /= nDims) then
+           write(stderr,'(4a,i8,a,i8)') myname_, &
+                ':: FATAL-- The size of the array descend(:) and nDims ', &
+                'must be equal (they both must equal the number of dimensions ', &
+                'of the unstructured Grid).  nDims = ',nDims, &
+	     ' size(descend) = ',size(descend)
+           call die(myname_,'size(descend)/=nDims')
+        endif
+     endif
+
+  endif
+
+       ! Initialize GGrid%coordinate_list and comparethe number of items 
+       ! to the number of dimensions of the unstructured nDims:
+
+  call List_init(GGrid%coordinate_list, CoordChars)
+
+       ! Check the coordinate_list
+
+  if(nDims /= List_nitem(GGrid%coordinate_list)) then
+     write(stderr,'(4a,i8,3a,i8)') myname_, &
+	  ':: FATAL-- The number of coordinate names supplied in the ', &
+	  'argument CoordChars must equal the number of dimensions ', &
+	  'specified by the argument nDims.  nDims = ',nDims, &
+	  ' CoordChars = ',CoordChars, ' number of dimensions in CoordChars = ', &
+	  List_nitem(GGrid%coordinate_list) 
+     call die(myname_)
+  endif
+
+  if(nDims <= 0) then
+     write(stderr,*) myname_, ':: ERROR nDims=0!'
+     call die(myname_,'nDims <= 0',nDims)
+  endif
+
+       ! PointData is a one-dimensional array containing all the gridpoint
+       ! coordinates.  As such, its size must equal nDims * nPoints.  True?
+
+  if(size(PointData) /= nDims * nPoints) then
+     write(stderr,'(3a,3(a,i8))') myname_, &
+	  ':: FATAL-- The length of the array PointData(:) must match ', &
+	  'the product of the input arguments nDims and nPoints.  ', &
+	  'nDims = ',nDims, ' nPoints = ',nPoints,&
+	  ' size(PointData) = ',size(PointData)
+     call die(myname_)
+  endif
+     
+       ! End of input argument sanity checks.
+
+       ! Create other List components of GGrid and build REAL
+       ! and INTEGER attribute lists for the AttrVect GGrid%data
+
+       ! Start off with things *guaranteed* to be in IAList and RAList.
+       ! The variable GlobGridNum is a CHARACTER parameter inherited 
+       ! from the declaration section of this module.
+
+  call List_init(IAList, GlobGridNum)
+  call List_init(RAList, CoordChars)
+
+  if(present(CoordSortOrder)) then
+
+     call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
+
+     call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
+	              NumShared,CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= nDims) then
+	call die(myname_,'CoordSortOrder must have the same items &
+	         & as CoordList',abs(nDims-NumShared))
+     endif
+
+  endif
+
+  if(present(WeightChars)) then
+     call List_init(GGrid%weight_list, WeightChars)
+     call List_append(RAList, GGrid%weight_list)
+  endif
+
+  if(present(OtherChars)) then
+     call List_init(GGrid%other_list, OtherChars)
+     call List_append(RAList, GGrid%other_list)
+  endif
+
+  if(present(IndexChars)) then
+     call List_init(GGrid%index_list, IndexChars)
+     call List_append(IAList, GGrid%index_list)
+  endif
+
+       ! Initialize GGrid%descend from descend(:).
+       ! If descend argument is not present, set it to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(nDims), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+        do n=1,nDims
+           GGrid%descend(n) = descend(n)
+        end do
+     else
+        do n=1,nDims
+           GGrid%descend(n) = .FALSE.
+        end do
+     endif
+        
+  endif ! if(present(CoordSortOrder))...
+  
+       ! Create Grid attribute data storage AttrVect GGrid%data:
+
+  call AttrVect_init(GGrid%data, IAList, RAList, nPoints)
+  call AttrVect_zero(GGrid%data)
+
+       ! Load up gridpoint coordinate data into GGrid%data.
+       ! Given how we've set up the real attributes of GGrid%data,
+       ! we have guaranteed the first nDims real attributes are 
+       ! the gridpoint coordinates.
+
+  do n=1,nPoints
+     nOffSet = (n-1) * nDims
+     do i=1,nDims
+	GGrid%data%rAttr(i,n) = PointData(nOffset + i)
+     end do
+  end do
+
+       ! If the argument CoordSortOrder was supplied, the entries
+       ! of GGrid will be sorted/permuted with this lexicographic
+       ! ordering, and the values of the GGrid INTEGER attribute 
+       ! GlobGridNum will be numbered to reflect this new ordering
+       ! scheme.
+
+  index = indexIA_(GGrid, GlobGridNum)
+
+  if(present(CoordSortOrder)) then ! Sort permute entries before
+                                   ! numbering them
+
+     call SortPermute_(GGrid) ! Sort / permute
+
+  endif ! if(present(CoordSortOrder))...
+
+       ! Number the gridpoints based on the AttrVect point index
+       ! (i.e., the second index in GGrid%data%iAttr)
+
+  do i=1, lsize_(GGrid)
+     GGrid%data%iAttr(index,i) = i
+  end do
+
+       ! Clean up temporary allocated structures:
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+
+ end subroutine initUnstructuredSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: initUnstructuredDP_ - Initialize an Unstructured GeneralGrid
+!
+! !DESCRIPTION:
+! Double precision version of initUnstructuredSP_
+!
+! !INTERFACE:
+
+ subroutine initUnstructuredDP_(GGrid, CoordChars, CoordSortOrder, descend, &
+                              WeightChars, OtherChars, IndexChars, nDims, &
+                              nPoints, PointData)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_realkinds,only : DP
+
+      use m_String,   only : String, char
+      use m_List,     only : List
+      use m_List,     only : List_init => init
+      use m_List,     only : List_clean => clean
+      use m_List,     only : List_nitem => nitem
+      use m_List,     only : List_nullify => nullify
+      use m_List,     only : List_copy => copy
+      use m_List,     only : List_append => append
+      use m_List,     only : List_shared => GetSharedListIndices
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*),             intent(in) :: CoordChars
+      character(len=*), optional,   intent(in) :: CoordSortOrder
+      character(len=*), optional,   intent(in) :: WeightChars
+      logical, dimension(:), optional, pointer :: descend
+      character(len=*), optional,   intent(in) :: OtherChars
+      character(len=*), optional,   intent(in) :: IndexChars
+      integer,                      intent(in) :: nDims
+      integer,                      intent(in) :: nPoints
+      real(DP), dimension(:),       pointer    :: PointData
+
+! !OUTPUT PARAMETERS:
+!
+      type(GeneralGrid), intent(out)   :: GGrid
+
+! !REVISION HISTORY:
+!  7Jun01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 22Aug02 - J. Larson <larson@mcs.anl.gov> - Implementation.
+! ______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initUnstructuredDP_'
+
+  integer :: i, ierr, index, n, nOffSet, NumShared
+  integer, dimension(:), pointer :: &
+       CoordListIndices, CoordSortOrderIndices
+  type(List) :: IAList, RAList
+
+       ! Nullify all GeneralGrid components
+
+  call List_nullify(GGrid%coordinate_list)
+  call List_nullify(GGrid%coordinate_sort_order)
+  call List_nullify(GGrid%weight_list)
+  call List_nullify(GGrid%other_list)
+  call List_nullify(GGrid%index_list)
+  nullify(GGrid%descend)
+
+       ! Sanity checks on input arguments:
+
+       ! If the LOGICAL descend(:) flags for sorting are present, 
+       ! make sure that (1) it is associated, 
+       ! (2) CoordSortOrder is also present, and 
+       ! (3) The size of descend(:) matches the size of Dims(:),
+       ! both of which correspond to the number of axes on the 
+       ! Cartesian Grid.
+
+  if(present(descend)) then
+
+     if(.not.associated(descend)) then
+        call die(myname_,'descend argument must be associated')
+     endif
+
+     if(.not. present(CoordSortOrder)) then
+        write(stderr,'(4a)') myname_, &
+             ':: FATAL -- Invocation with the argument descend(:) present ', &
+             'requires the presence of the argument CoordSortOrder, ', &
+             'which was not provided.'
+        call die(myname_,'Argument CoordSortOrder was not provided')
+     endif
+
+     if(present(descend)) then
+        if(size(descend) /= nDims) then
+           write(stderr,'(4a,i8,a,i8)') myname_, &
+                ':: FATAL-- The size of the array descend(:) and nDims ', &
+                'must be equal (they both must equal the number of dimensions ', &
+                'of the unstructured Grid).  nDims = ',nDims, &
+	     ' size(descend) = ',size(descend)
+           call die(myname_,'size(descend)/=nDims')
+        endif
+     endif
+
+  endif
+
+       ! Initialize GGrid%coordinate_list and comparethe number of items 
+       ! to the number of dimensions of the unstructured nDims:
+
+  call List_init(GGrid%coordinate_list, CoordChars)
+
+       ! Check the coordinate_list
+
+  if(nDims /= List_nitem(GGrid%coordinate_list)) then
+     write(stderr,'(4a,i8,3a,i8)') myname_, &
+	  ':: FATAL-- The number of coordinate names supplied in the ', &
+	  'argument CoordChars must equal the number of dimensions ', &
+	  'specified by the argument nDims.  nDims = ',nDims, &
+	  ' CoordChars = ',CoordChars, ' number of dimensions in CoordChars = ', &
+	  List_nitem(GGrid%coordinate_list) 
+     call die(myname_)
+  endif
+
+  if(nDims <= 0) then
+     write(stderr,*) myname_, ':: ERROR nDims=0!'
+     call die(myname_,'nDims <= 0',nDims)
+  endif
+
+       ! PointData is a one-dimensional array containing all the gridpoint
+       ! coordinates.  As such, its size must equal nDims * nPoints.  True?
+
+  if(size(PointData) /= nDims * nPoints) then
+     write(stderr,'(3a,3(a,i8))') myname_, &
+	  ':: FATAL-- The length of the array PointData(:) must match ', &
+	  'the product of the input arguments nDims and nPoints.  ', &
+	  'nDims = ',nDims, ' nPoints = ',nPoints,&
+	  ' size(PointData) = ',size(PointData)
+     call die(myname_)
+  endif
+     
+       ! End of input argument sanity checks.
+
+       ! Create other List components of GGrid and build REAL
+       ! and INTEGER attribute lists for the AttrVect GGrid%data
+
+       ! Start off with things *guaranteed* to be in IAList and RAList.
+       ! The variable GlobGridNum is a CHARACTER parameter inherited 
+       ! from the declaration section of this module.
+
+  call List_init(IAList, GlobGridNum)
+  call List_init(RAList, CoordChars)
+
+  if(present(CoordSortOrder)) then
+
+     call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
+
+     call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
+	              NumShared,CoordListIndices,CoordSortOrderIndices)
+
+     deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
+     if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
+     
+     if(NumShared /= nDims) then
+	call die(myname_,'CoordSortOrder must have the same items &
+	         & as CoordList',abs(nDims-NumShared))
+     endif
+
+  endif
+
+  if(present(WeightChars)) then
+     call List_init(GGrid%weight_list, WeightChars)
+     call List_append(RAList, GGrid%weight_list)
+  endif
+
+  if(present(OtherChars)) then
+     call List_init(GGrid%other_list, OtherChars)
+     call List_append(RAList, GGrid%other_list)
+  endif
+
+  if(present(IndexChars)) then
+     call List_init(GGrid%index_list, IndexChars)
+     call List_append(IAList, GGrid%index_list)
+  endif
+
+       ! Initialize GGrid%descend from descend(:).
+       ! If descend argument is not present, set it to the default .false.
+
+  if(present(CoordSortOrder)) then
+
+     allocate(GGrid%descend(nDims), stat=ierr)
+     if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
+
+     if(present(descend)) then
+        do n=1,nDims
+           GGrid%descend(n) = descend(n)
+        end do
+     else
+        do n=1,nDims
+           GGrid%descend(n) = .FALSE.
+        end do
+     endif
+        
+  endif ! if(present(CoordSortOrder))...
+  
+       ! Create Grid attribute data storage AttrVect GGrid%data:
+
+  call AttrVect_init(GGrid%data, IAList, RAList, nPoints)
+  call AttrVect_zero(GGrid%data)
+
+       ! Load up gridpoint coordinate data into GGrid%data.
+       ! Given how we've set up the real attributes of GGrid%data,
+       ! we have guaranteed the first nDims real attributes are 
+       ! the gridpoint coordinates.
+
+  do n=1,nPoints
+     nOffSet = (n-1) * nDims
+     do i=1,nDims
+	GGrid%data%rAttr(i,n) = PointData(nOffset + i)
+     end do
+  end do
+
+       ! If the argument CoordSortOrder was supplied, the entries
+       ! of GGrid will be sorted/permuted with this lexicographic
+       ! ordering, and the values of the GGrid INTEGER attribute 
+       ! GlobGridNum will be numbered to reflect this new ordering
+       ! scheme.
+
+  index = indexIA_(GGrid, GlobGridNum)
+
+  if(present(CoordSortOrder)) then ! Sort permute entries before
+                                   ! numbering them
+
+     call SortPermute_(GGrid) ! Sort / permute
+
+  endif ! if(present(CoordSortOrder))...
+
+       ! Number the gridpoints based on the AttrVect point index
+       ! (i.e., the second index in GGrid%data%iAttr)
+
+  do i=1, lsize_(GGrid)
+     GGrid%data%iAttr(index,i) = i
+  end do
+
+       ! Clean up temporary allocated structures:
+
+  call List_clean(IAList)
+  call List_clean(RAList)
+
+ end subroutine initUnstructuredDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a GeneralGrid
+!
+! !DESCRIPTION:
+! This routine deallocates all attribute storage space for the input/output
+! {\tt GeneralGrid} argument {\tt GGrid}, and destroys all of its {\tt List}
+! components and sorting flags.  The success (failure) of this operation is
+! signified by the zero (non-zero) value of the optional {\tt INTEGER} 
+! output argument {\tt stat}.
+!
+! !INTERFACE:
+
+    subroutine clean_(GGrid, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_List,     only : List_clean => clean
+      use m_List,     only : List_allocated => allocated
+      use m_AttrVect, only : AttrVect_clean => clean
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(inout) :: GGrid
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 25Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 20Mar01 - J.W. Larson <larson@mcs.anl.gov> - complete version.
+!  1Mar01 - E.T. Ong <eong@mcs.anl.gov> - removed dies to prevent
+!           crashes when cleaning uninitialized attrvects. Added
+!           optional stat argument.
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - a more rigorous revision
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ierr
+
+  if(present(stat)) then
+
+     stat=0
+     call AttrVect_clean(GGrid%data,ierr)
+     if(ierr/=0) stat=ierr
+
+     call List_clean(GGrid%coordinate_list,ierr)
+     if(ierr/=0) stat=ierr
+
+     if(List_allocated(GGrid%coordinate_sort_order)) then
+	call List_clean(GGrid%coordinate_sort_order,ierr)
+	if(ierr/=0) stat=ierr
+     endif
+
+     if(List_allocated(GGrid%weight_list)) then
+	call List_clean(GGrid%weight_list,ierr)
+	if(ierr/=0) stat=ierr
+     endif
+
+     if(List_allocated(GGrid%other_list)) then 
+	call List_clean(GGrid%other_list,ierr)
+	if(ierr/=0) stat=ierr
+     endif
+
+     if(List_allocated(GGrid%index_list)) then 
+	call List_clean(GGrid%index_list,ierr)
+	if(ierr/=0) stat=ierr
+     endif
+
+     if(associated(GGrid%descend)) then
+	deallocate(GGrid%descend, stat=ierr)
+	if(ierr/=0) stat=ierr
+     endif
+
+  else
+
+     call AttrVect_clean(GGrid%data)
+
+     call List_clean(GGrid%coordinate_list)
+
+     if(List_allocated(GGrid%coordinate_sort_order)) then
+	call List_clean(GGrid%coordinate_sort_order)
+     endif
+
+     if(List_allocated(GGrid%weight_list)) then
+	call List_clean(GGrid%weight_list)
+     endif
+
+     if(List_allocated(GGrid%other_list)) then 
+	call List_clean(GGrid%other_list)
+     endif
+
+     if(List_allocated(GGrid%index_list)) then 
+	call List_clean(GGrid%index_list)
+     endif
+
+     if(associated(GGrid%descend)) then
+	deallocate(GGrid%descend, stat=ierr)
+	if(ierr/=0) call die(myname_,'deallocate(GGrid%descend)',ierr) 
+     endif
+
+  endif
+
+ end subroutine clean_
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: zero_ - Set GeneralGrid Data to Zero 
+!
+! !DESCRIPTION:
+! This routine sets all of the point values of the integer and real 
+! attributes of an the input/output {\tt GeneralGrid} argument {\tt GGrid}
+! to zero.  The default action is to set the values of all the real and  
+! integer attributes to zero.
+!
+! !INTERFACE:
+
+ subroutine zero_(GGrid, zeroReals, zeroInts)
+
+! !USES:
+
+
+     use m_die,only     : die
+     use m_stdio,only   : stderr
+
+     use m_AttrVect, only : AttrVect_zero => zero
+
+     implicit none
+! !INPUT/OUTPUT PARAMETERS:
+!
+     type(GeneralGrid),    intent(INOUT) :: GGrid
+
+! !INPUT PARAMETERS:
+
+     logical, optional, intent(IN)    :: zeroReals
+     logical, optional, intent(IN)    :: zeroInts
+
+
+! !REVISION HISTORY:
+! 11May08 - R. Jacob <jacob@mcs.anl.gov> - initial prototype/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::zero_'
+
+  logical myZeroReals, myZeroInts
+
+  if(present(zeroReals)) then
+     myZeroReals = zeroReals
+  else
+     myZeroReals = .TRUE.
+  endif
+
+  if(present(zeroInts)) then
+     myZeroInts = zeroInts
+  else
+     myZeroInts = .TRUE.
+  endif
+
+  call AttrVect_zero(GGrid%data,myZeroReals,myZeroInts)
+
+ end subroutine zero_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dims_ - Return the Dimensionality of a GeneralGrid
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} function returns the number of physical dimensions 
+! of the input {\tt GeneralGrid} argument {\tt GGrid}.
+!
+! !INTERFACE:
+
+ integer function dims_(GGrid)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_List,     only : List_nitem => nitem
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: GGrid
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::dims_'
+
+
+ dims_ = List_nitem(GGrid%coordinate_list)
+
+ if(dims_<=0) then
+    call die(myname_,"GGrid has zero dimensions",dims_)
+ endif
+
+ end function dims_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexIA - Index an Integer Attribute
+!
+! !DESCRIPTION:
+! This function returns an {\tt INTEGER}, corresponding to the location 
+! of an integer attribute within the input {\tt GeneralGrid} argument 
+! {\tt GGrid}.  For example, every {\tt GGrid} has at least one integer 
+! attribute (namely the global gridpoint index {\tt 'GlobGridNum'}).
+! The array of integer values for the attribute {\tt 'GlobGridNum'} is 
+! stored in 
+! \begin{verbatim}
+! {\tt GGrid%data%iAttr(indexIA_(GGrid,'GlobGridNum'),:)}.
+! \end{verbatim}
+! If {\tt indexIA\_()} is unable to match {\tt item} to any of the integer
+! attributes present in {\tt GGrid}, the resulting value is zero which is 
+! equivalent to an error.  The optional input {\tt CHARACTER} arguments 
+! {\tt perrWith} and {\tt dieWith} control how such errors are handled.  
+! Below are the rules how error handling is controlled by using 
+! {\tt perrWith} and {\tt dieWith}:
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexIA\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied 
+! traceback information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied 
+! traceback information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ integer function indexIA_(GGrid, item, perrWith, dieWith)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      use m_AttrVect,     only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),          intent(in) :: GGrid
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Cleaned up error
+!           handling logic.
+!  2Aug02 - Jay Larson <larson@mcs.anl.gov> - Further refinement
+!           of error handling.
+!EOP ___________________________________________________________________
+!
+
+ character(len=*), parameter :: myname_=myname//'::indexIA_'
+
+ type(String) :: myTrace
+
+       ! Generate a traceback String
+
+  if(present(dieWith)) then
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then
+        call GenTraceBackString(myTrace, perrWith, myname_)
+     else
+        call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Call AttrVect_indexIA() accordingly:
+
+  if( present(dieWith) .or. &
+     ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
+     indexIA_ = AttrVect_indexIA(GGrid%data, item, &
+                                 dieWith=String_ToChar(myTrace))
+  else  ! perrWith but no dieWith case
+     indexIA_ = AttrVect_indexIA(GGrid%data, item, &
+                   perrWith=String_ToChar(myTrace))
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexIA_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexRA - Index a Real Attribute
+!
+! !DESCRIPTION:
+
+! This function returns an {\tt INTEGER}, corresponding to the location 
+! of an integer attribute within the input {\tt GeneralGrid} argument 
+! {\tt GGrid}.  For example, every {\tt GGrid} has at least one integer 
+! attribute (namely the global gridpoint index {\tt 'GlobGridNum'}).
+! The array of integer values for the attribute {\tt 'GlobGridNum'} is 
+! stored in 
+! \begin{verbatim}
+! {\tt GGrid%data%iAttr(indexRA_(GGrid,'GlobGridNum'),:)}.
+! \end{verbatim}
+! If {\tt indexRA\_()} is unable to match {\tt item} to any of the integer
+! attributes present in {\tt GGrid}, the resulting value is zero which is 
+! equivalent to an error.  The optional input {\tt CHARACTER} arguments 
+! {\tt perrWith} and {\tt dieWith} control how such errors are handled.  
+! Below are the rules how error handling is controlled by using 
+! {\tt perrWith} and {\tt dieWith}:
+! \begin{enumerate}
+! \item if neither {\tt perrWith} nor {\tt dieWith} are present, 
+! {\tt indexRA\_()} terminates execution with an internally generated
+! error message;
+! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error 
+! message is written to {\tt stderr} incorporating user-supplied 
+! traceback information stored in the argument {\tt perrWith};
+! \item if {\tt dieWith} is present, execution terminates with an error 
+! message written to {\tt stderr} that incorporates user-supplied 
+! traceback information stored in the argument {\tt dieWith}; and 
+! \item if both {\tt perrWith} and {\tt dieWith} are present, execution 
+! terminates with an error message using {\tt dieWith}, and the argument
+! {\tt perrWith} is ignored.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ integer function indexRA_(GGrid, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      use m_AttrVect,     only : AttrVect_indexRA => indexRA
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),          intent(in)  :: GGrid
+      character(len=*),           intent(in)  :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Cleaned up error
+!           handling logic.
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::indexRA_'
+
+
+ type(String) :: myTrace
+
+       ! Generate a traceback String
+
+  if(present(dieWith)) then ! append myname_ onto dieWith
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! append myname_ onto perrwith
+        call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBack String
+        call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Call AttrVect_indexRA() accordingly:
+
+  if( present(dieWith) .or. &
+     ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
+     indexRA_ = AttrVect_indexRA(GGrid%data, item, &
+                                 dieWith=String_ToChar(myTrace))
+  else  ! perrWith but no dieWith case
+     indexRA_ = AttrVect_indexRA(GGrid%data, item, &
+                   perrWith=String_ToChar(myTrace))
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexRA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize - Number of Grid Points
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} function returns the number of grid points stored 
+! in the input {\tt GeneralGrid} argument {\tt GGrid}.  Note that the 
+! value returned will be the number of points stored on a local process 
+! in the case of a distributed {\tt GeneralGrid}.
+!
+! !INTERFACE:
+
+ integer function lsize_(GGrid)
+!
+! !USES:
+!
+      use m_List,     only : List
+      use m_List,     only : List_allocated => allocated
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_die,      only : die    
+      
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: GGrid
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - slight logic change.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Bug fix and use of
+!           List_allocated() function to check for existence of 
+!           attributes.
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - more rigorous revision
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::lsize_'
+
+ if(List_allocated(GGrid%data%rList) .and. &
+      List_allocated(GGrid%data%iList)) then
+
+    lsize_ = AttrVect_lsize( GGrid%data )
+
+ else
+
+    call die(myname_,"Argument GGrid%data is not associated!")
+
+ endif
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportIAttr_ - Return GeneralGrid INTEGER Attribute as a Vector
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt GeneralGrid} argument 
+! {\tt GGrid} the integer attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in 
+! the {\tt INTEGER} output array {\tt outVect}, and its length in the 
+! output {\tt INTEGER} argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%iList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) before this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportIAttr_(GGrid, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GeneralGrid),      intent(in)  :: GGrid
+      character(len=*),       intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: outVect
+      integer,  optional,     intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportIAttr_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(lsize)) then
+     call AttrVect_exportIAttr(GGrid%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportIAttr(GGrid%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrSP_ - Return GeneralGrid REAL Attribute as a Vector
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt GeneralGrid} argument 
+! {\tt GGrid} the real attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in 
+! the {\tt REAL} output array {\tt outVect}, and its length in the 
+! output {\tt INTEGER} argument {\tt lsize}.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%rList}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt outVect} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt outVect},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) before this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt outVect}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportRAttrSP_(GGrid, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_realkinds,  only : SP
+
+      use m_AttrVect,   only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GeneralGrid),          intent(in)  :: GGrid
+      character(len=*),           intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      real(SP),  dimension(:),    pointer     :: outVect
+      integer,   optional,        intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrSP_'
+
+       ! Export the data (inheritance from AttrVect)
+
+  if(present(lsize)) then
+     call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ---------------------------------------------------------------------
+!
+! !IROUTINE: exportRAttrDP_ - Return GeneralGrid REAL Attribute as a Vector
+!
+! !DESCRIPTION:
+! double precision version of exportRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine exportRAttrDP_(GGrid, AttrTag, outVect, lsize)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_realkinds,  only : DP
+
+      use m_AttrVect,   only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GeneralGrid),          intent(in)  :: GGrid
+      character(len=*),           intent(in)  :: AttrTag
+
+! !OUTPUT PARAMETERS: 
+
+      real(DP),  dimension(:),    pointer     :: outVect
+      integer,   optional,        intent(out) :: lsize
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!_______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportRAttrDP_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(lsize)) then
+     call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect, lsize)
+  else
+     call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect)
+  endif
+
+ end subroutine exportRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importIAttr_ - Import GeneralGrid INTEGER Attribute
+!
+! !DESCRIPTION:
+! This routine imports data provided in the input {\tt INTEGER} vector 
+! {\tt inVect} into the {\tt GeneralGrid} argument {\tt GGrid}, storing 
+! it as the integer attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}.  The input 
+! {\tt INTEGER} argument {\tt lsize} is used to ensure there is 
+! sufficient space in the {\tt GeneralGrid} to store the data.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%iList}.
+!
+! !INTERFACE:
+
+ subroutine importIAttr_(GGrid, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),       intent(in)    :: AttrTag
+      integer,  dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GeneralGrid),      intent(inout) :: GGrid
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importIAttr_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(GGrid)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
+	  'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(GGrid%data, AttrTag, inVect, lsize)
+
+ end subroutine importIAttr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrSP_ - Import GeneralGrid REAL Attribute
+!
+! !DESCRIPTION:
+! This routine imports data provided in the input {\tt REAL} vector 
+! {\tt inVect} into the {\tt GeneralGrid} argument {\tt GGrid}, storing 
+! it as the real attribute corresponding to the tag defined in 
+! the input {\tt CHARACTER} argument {\tt AttrTag}.  The input 
+! {\tt INTEGER} argument {\tt lsize} is used to ensure there is 
+! sufficient space in the {\tt GeneralGrid} to store the data.
+!
+! {\bf N.B.:}  This routine will fail if the {\tt AttrTag} is not in 
+! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%rList}.
+!
+! !INTERFACE:
+
+ subroutine importRAttrSP_(GGrid, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_die ,          only : MP_perr_die
+      use m_stdio ,        only : stderr
+
+      use m_realkinds,     only : SP
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),           intent(in)    :: AttrTag
+      real(SP), dimension(:),     pointer       :: inVect
+      integer,                    intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GeneralGrid),          intent(inout) :: GGrid
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrSP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(GGrid)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
+	  'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(GGrid%data, AttrTag, inVect, lsize)
+
+ end subroutine importRAttrSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+!
+! !IROUTINE: importRAttrDP_ - Import GeneralGrid REAL Attribute
+!
+! !DESCRIPTION:
+! Double precision version of importRAttrSP_
+!
+! !INTERFACE:
+
+ subroutine importRAttrDP_(GGrid, AttrTag, inVect, lsize)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_die ,          only : MP_perr_die
+      use m_stdio ,        only : stderr
+
+      use m_realkinds,     only : DP
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      character(len=*),           intent(in)    :: AttrTag
+      real(DP), dimension(:),     pointer       :: inVect
+      integer,                    intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GeneralGrid),          intent(inout) :: GGrid
+
+! !REVISION HISTORY:
+! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
+!_______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importRAttrDP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(GGrid)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
+	  'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(GGrid%data, AttrTag, inVect, lsize)
+
+ end subroutine importRAttrDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Sort_ - Generate Sort Permutation Defined by Arbitrary Keys.
+!
+! !DESCRIPTION:
+! The subroutine {\tt Sort\_()} uses the list of keys present in the
+! input  {\tt List} variable {\tt key\_List}.  This list of keys is 
+! checked to ensure that {\em only} coordinate attributes are present 
+! in the sorting keys, and that there are no redundant keys.  Once 
+! checked, this list is used to find the appropriate real attributes
+! referenced by the items in {\tt key\_list} ( that is, it identifies the 
+! appropriate entries in {\tt GGrid\%data\%rList}), and then uses these 
+! keys to generate a an output permutation {\tt perm} that will put
+! the entries of the attribute vector {\tt GGrid\%data} in lexicographic 
+! order as defined by {\tt key\_list} (the ordering in {\tt key\_list} 
+! being from left to right.
+!
+! !INTERFACE:
+
+ subroutine Sort_(GGrid, key_List, perm, descend)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_AttrVect,     only : AttrVect_Sort => Sort
+      use m_List,        only : List_nitem => nitem
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),               intent(in) :: GGrid
+      type(List),                      intent(in) :: key_list
+      logical, dimension(:), optional, intent(in) :: descend
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, dimension(:), pointer              :: perm
+
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+! 20Mar01 - Jay Larson <larson@mcs.anl.gov> - Final working version.
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::Sort_'
+ logical, dimension(:), allocatable :: descending
+ integer :: n, ierr
+
+        ! Here is how we transmit the sort order keys stored
+        ! in descending (if present):
+
+  n = List_nitem(key_list)
+  allocate(descending(n), stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,"allocate(descending...",ierr)
+  endif
+
+  if(present(descend)) then
+     descending = descend
+  else
+     descending = .false.
+  endif
+
+        ! This is a straightforward call to AttrVect_Sort().
+  
+  call AttrVect_Sort(GGrid%data, key_list, perm, descending) 
+
+        ! Clean up...
+
+  deallocate(descending, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,"deallocate(descending...",ierr)
+  endif
+
+ end subroutine Sort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Sortg_ - Generate Sort Permutation Based on GeneralGrid Keys.
+!
+! !DESCRIPTION:
+! The subroutine {\tt Sortg\_()} uses the list of sorting keys present in 
+! the input  {\tt GeneralGrid} variable {\tt GGrid\%coordinate\_sort\_order}
+! to create a sort permutation {\tt perm(:)}.  Sorting is either in ascending
+! or descending order based on the entries of {\tt GGrid\%descend(:)}.
+! The output index permutation is stored in the array {\tt perm(:)} that 
+! will put the entries of the attribute vector {\tt GGrid\%data} in 
+! lexicographic order as defined by {\tt GGrid\%coordinate\_sort\_order}. The 
+! ordering in {\tt GGrid\%coordinate\_sort\_order} being from left to right.
+!
+! {\bf N.B.:}  This routine returnss an allocatable array perm(:).  This 
+! allocated array must be deallocated when the user no longer needs it.  
+! Failure to do so will cause a memory leak.
+!
+! {\bf N.B.:}  This routine will fail if {\tt GGrid} has not been initialized 
+! with sort keys in the {\tt List} component {\tt GGrid\%coordinate\_sort\_order}.
+!
+! !INTERFACE:
+
+ subroutine Sortg_(GGrid, perm)
+
+!
+! !USES:
+!
+      use m_List, only : List_allocated => allocated
+      use m_die,  only : die
+   
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),     intent(in) :: GGrid
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, dimension(:), pointer    :: perm
+
+! !REVISION HISTORY:
+! 22Mar01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
+!  5Aug02 - E. Ong <eong@mcs.anl.gov> - revise with more error checking.
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::Sortg_'
+
+     if(.not.List_allocated(GGrid%coordinate_sort_order)) then
+	call die(myname_, "GGrid%coordinate_aort_order must be &
+	         &allocated for use in any sort function")
+     endif
+
+     if(associated(GGrid%descend)) then
+	call Sort_(GGrid, GGrid%coordinate_sort_order, &
+	               perm, GGrid%descend)
+     else
+	call Sort_(GGrid=GGrid, key_list=GGrid%coordinate_sort_order, &
+	               perm=perm)
+     endif
+
+ end subroutine Sortg_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Permute_ - Permute GeneralGrid Attributes Using Supplied Index Permutation
+!
+! !DESCRIPTION:
+! The subroutine {\tt Permute\_()} uses an input index permutation {\tt perm} 
+! to re-order the coordinate data stored in the {\tt GeneralGrid} argument 
+! {\tt GGrid}.  This permutation can be generated by either of the routines
+! {\tt Sort\_()} or {\tt Sortg\_()} contained in this module.
+!
+! !INTERFACE:
+
+ subroutine Permute_(GGrid, perm)
+
+!
+! !USES:
+!
+
+      use m_stdio
+      use m_die
+
+      use m_AttrVect,     only : AttrVect
+      use m_AttrVect, only : AttrVect_Permute => Permute
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer, dimension(:), intent(in)    :: perm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid),     intent(inout) :: GGrid
+
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 10Apr01 - Jay Larson <larson@mcs.anl.gov> - API modified, working
+!           code.
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::Permute_'
+
+        ! This is a straightforward call to AttrVect_Permute:
+
+  call AttrVect_Permute(GGrid%data, perm)
+
+ end subroutine Permute_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SortPermute_ - Sort and Permute GeneralGrid Attributes
+!
+! !DESCRIPTION:
+! The subroutine {\tt SortPermute\_()} uses the list of keys defined in 
+! {\tt GGrid\%coordinate\_sort\_order} to create an index permutation 
+! {\tt perm}, which is then applied to re-order the coordinate data stored 
+! in the {\tt GeneralGrid} argument {\tt GGrid} (more specifically, the 
+! gridpoint data stored in {\tt GGrid\%data}.  This permutation is generated  
+! by the routine {\tt Sortg\_()} contained in this module.  The permutation 
+! is carried out by the routine {\tt Permute\_()} contained in this module.
+!
+! {\bf N.B.:}  This routine will fail if {\tt GGrid} has not been initialized 
+! with sort keys in the {\tt List} component {\tt GGrid\%coordinate\_sort\_order}.
+!
+! !INTERFACE:
+
+ subroutine SortPermute_(GGrid)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid),     intent(inout)   :: GGrid
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 10Apr01 - Jay Larson <larson@mcs.anl.gov> - API modified, working
+!           code.
+! 13Apr01 - Jay Larson <larson@mcs.anl.gov> - Simplified API and
+!           code (Thanks to Tony Craig of NCAR for detecting the
+!           bug that inspired these changes).
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::SortPermute_'
+
+ integer, dimension(:), pointer :: perm
+ integer :: ierr
+
+  call Sortg_(GGrid, perm)
+
+  call Permute_(GGrid, perm)
+
+! Clean up--deallocate temporary permutation array:
+
+  deallocate(perm, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,"deallocate(perm)",ierr)
+  endif
+
+ end subroutine SortPermute_
+
+ end module m_GeneralGrid
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGridComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGridComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GeneralGridComms.F90	(revision 4775)
@@ -0,0 +1,1536 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GeneralGridComms.F90,v 1.23 2004-04-21 22:16:33 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GeneralGridComms - Communications for the GeneralGrid type.
+!
+! !DESCRIPTION:
+!
+! In this module, we define communications methods specific to the 
+! {\tt GeneralGrid} class (see the module {\tt m\_GeneralGrid} for more 
+! information about this class and its methods).
+!
+! !INTERFACE:
+ module m_GeneralGridComms
+!
+! !USES:
+!
+      use m_GeneralGrid ! GeneralGrid class and its methods
+
+
+      implicit none
+
+      private   ! except
+
+      public :: gather          ! gather all local vectors to the root
+      public :: scatter         ! scatter from the root to all PEs
+      public :: bcast           ! bcast from root to all PEs
+      public :: send            ! Blocking SEND
+      public :: recv            ! Blocking RECEIVE
+
+    interface gather ; module procedure &
+              GM_gather_, &
+              GSM_gather_ 
+    end interface
+    interface scatter ; module procedure &
+              GM_scatter_, &
+              GSM_scatter_ 
+    end interface
+    interface bcast ; module procedure bcast_ ; end interface
+    interface send  ; module procedure send_  ; end interface
+    interface recv  ; module procedure recv_  ; end interface
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - Initial module/APIs
+!       07Jun01 - J.W. Larson <larson@mcs.anl.gov> - Added point-to-point
+!       27Mar02 - J.W. Larson <larson@mcs.anl.gov> - Overhaul of error
+!                 handling calls throughout this module.
+!       05Aug02 - E. Ong <eong@mcs.anl.gov> - Added buffer association 
+!                 error checks to avoid making bad MPI calls
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_GeneralGridComms'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: send_ - Point-to-point blocking send for the GeneralGrid.
+!
+! !DESCRIPTION:  The point-to-point send routine {\tt send\_()} sends 
+! the input {\tt GeneralGrid} argument {\tt iGGrid} to component 
+! {\tt comp\_id}.  
+! The message is identified by the tag defined by the {\tt INTEGER} 
+! argument {\tt TagBase}.  The value of {\tt TagBase} must match the 
+! value used in the call to {\tt recv\_()} on process {\tt dest}.  The 
+! success (failure) of this operation corresponds to a zero (nonzero) 
+! value for the output {\tt INTEGER} flag {\tt status}. 
+! The argument will be sent to the local root of the component.
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! between {\tt TagBase} and {\tt TagBase+20}, inclusive.  This is 
+! because {\tt send\_()} performs one send operation set up the header
+! transfer, up to five {\tt List\_send} operations (two {\tt MPI\_SEND} 
+! calls in each), two send operations to transfer {\tt iGGrid\%descend(:)},
+! and finally the send of the {\tt AttrVect} component {\tt iGGrid\%data} 
+! (which comprises eight {\tt MPI\_SEND} operations).
+!
+! !INTERFACE:
+
+ subroutine send_(iGGrid, comp_id, TagBase, status)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      use m_MCTWorld, only : ComponentToWorldRank
+      use m_MCTWorld, only : ThisMCTWorld
+
+      use m_AttrVectComms,only : AttrVect_send => send
+
+      use m_List, only : List_send => send
+      use m_List, only : List_allocated => allocated
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in) :: iGGrid
+      integer,           intent(in) :: comp_id
+      integer,           intent(in) :: TagBase
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out) :: status
+
+! !REVISION HISTORY:
+!       04Jun01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       07Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!       10Jun01 - J.W. Larson <larson@mcs.anl.gov> - Bug fixes--now works.
+!       11Jun01 - R. Jacob <jacob@mcs.anl.gov> use component id as input
+!                 argument.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!                 (if present).
+!       15Feb02 - J.W. Larson <larson@mcs.anl.gov> - Made input argument
+!                 comm optional.
+!       13Jun02 - J.W. Larson <larson@mcs.anl.gov> - Removed the argument
+!                 comm.  This routine is now explicitly for intercomponent
+!                 communications only.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::send_'
+
+  integer :: ierr
+  integer :: dest
+  logical :: HeaderAssoc(6)
+
+      ! Initialize status (if present)
+
+  if(present(status)) status = 0
+
+  dest = ComponentToWorldRank(0, comp_id, ThisMCTWorld)
+
+      ! Step 1. Check elements of the GeneralGrid header to see 
+      ! which components of it are allocated.  Load the results
+      ! into HeaderAssoc(:), and send it to process dest.
+
+  HeaderAssoc(1) = List_allocated(iGGrid%coordinate_list)
+  HeaderAssoc(2) = List_allocated(iGGrid%coordinate_sort_order)
+  HeaderAssoc(3) = associated(iGGrid%descend)
+  HeaderAssoc(4) = List_allocated(iGGrid%weight_list)
+  HeaderAssoc(5) = List_allocated(iGGrid%other_list)
+  HeaderAssoc(6) = List_allocated(iGGrid%index_list)
+
+  call MPI_SEND(HeaderAssoc, 6, MP_LOGICAL, dest, TagBase, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_SEND(HeaderAssoc...',ierr)
+  endif
+
+       ! Step 2.  If iGGrid%coordinate_list is defined, send it.
+
+  if(HeaderAssoc(1)) then
+    call List_send(iGGrid%coordinate_list, dest, TagBase+1, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       write(stderr,*) myname_,':: call List_send(iGGrid%coordinate_list...', &
+	    'Error flag ierr = ',ierr
+       if(present(status)) then
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_send(iGGrid%coordinate_list...',ierr)
+       endif
+    endif
+  else  ! This constitutes an error, as a GeneralGrid must have coordinates
+
+     if(present(status)) then
+	write(stderr,*) myname_,':: Error.  GeneralGrid%coordinate_list undefined.'
+	status = -1
+	return
+     else
+	call die(myname_,'::  Error.  GeneralGrid%coordinate_list undefined.',-1)
+     endif
+
+  endif ! if(HeaderAssoc(1))...
+
+       ! Step 3.  If iGGrid%coordinate_sort_order is defined, send it.
+
+  if(HeaderAssoc(2)) then
+    call List_send(iGGrid%coordinate_sort_order, dest, TagBase+3, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_send(iGGrid%coordinate_sort_order...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_send(iGGrid%coordinate_sort_order...',ierr)
+       endif
+    endif
+
+  endif ! if(HeaderAssoc(2))...
+
+       ! Step 4.  If iGGrid%descend is allocated, determine its size,
+       ! send this size, and then send the elements of iGGrid%descend.
+     
+  if(HeaderAssoc(3)) then
+
+     if(size(iGGrid%descend)<=0) call die(myname_,'size(iGGrid%descend)<=0')
+
+     call MPI_SEND(size(iGGrid%descend), 1, MP_type(size(iGGrid%descend)), &
+                   dest, TagBase+5, ThisMCTWorld%MCT_comm, ierr)
+     if(ierr /= 0) then
+	call MP_perr_die(myname_,':: call MPI_SEND(size(iGGrid%descend)...',ierr)
+     endif
+
+     call MPI_SEND(iGGrid%descend, size(iGGrid%descend), MP_type(iGGrid%descend(1)), &
+                   dest, TagBase+6, ThisMCTWorld%MCT_comm, ierr)
+     if(ierr /= 0) then
+	call MP_perr_die(myname_,':: call MPI_SEND(iGGrid%descend...',ierr)
+     endif
+
+  endif ! if(HeaderAssoc(3))...
+
+       ! Step 5.  If iGGrid%weight_list is defined, send it.
+
+  if(HeaderAssoc(4)) then
+
+    call List_send(iGGrid%weight_list, dest, TagBase+7, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_send(iGGrid%weight_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_send(iGGrid%weight_list...',ierr)
+       endif
+    endif
+
+  endif ! if(HeaderAssoc(4))...
+
+       ! Step 6.  If iGGrid%other_list is defined, send it.
+
+  if(HeaderAssoc(5)) then
+
+    call List_send(iGGrid%other_list, dest, TagBase+9, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_send(iGGrid%other_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_send(iGGrid%other_list...',ierr)
+       endif
+    endif
+
+  endif ! if(HeaderAssoc(5))...
+
+       ! Step 7.  If iGGrid%index_list is defined, send it.
+
+  if(HeaderAssoc(6)) then
+
+    call List_send(iGGrid%index_list, dest, TagBase+11, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_send(iGGrid%index_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_send(iGGrid%index_list...',ierr)
+       endif
+    endif
+
+  else  ! This constitutes an error, as a GeneralGrid must at a minimum
+        ! contain the index GlobGridNum
+
+     if(present(status)) then
+	write(stderr,*) myname_,':: Error.  GeneralGrid%index_list undefined.'
+	status = -2
+	return
+     else
+	call die(myname_,'::  Error.  GeneralGrid%index_list undefined.',-2)
+     endif
+
+  endif ! if(HeaderAssoc(6))...
+
+       ! Step 8.  Finally, send the AttrVect iGGrid%data.
+
+  call AttrVect_send(iGGrid%data, dest, TagBase+13, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+	write(stderr,*) myname_,':: call AttrVect_send(iGGrid%data...'
+	status = ierr
+	return
+     else
+	call die(myname_,':: call AttrVect_send(iGGrid%data...',ierr)
+     endif
+  endif
+
+       ! The GeneralGrid send is now complete.
+
+ end subroutine send_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: recv_ - Point-to-point blocking recv for the GeneralGrid.
+!
+! !DESCRIPTION:  The point-to-point receive routine {\tt recv\_()} 
+! receives the output {\tt GeneralGrid} argument {\tt oGGrid} from component
+! {\tt comp\_id}.  The message is identified by the tag defined by the 
+! {\tt INTEGER} argument {\tt TagBase}.  The value of {\tt TagBase} must 
+! match the value used in the call to {\tt send\_()} on the other component.
+! The success (failure) of this operation corresponds to a zero (nonzero) 
+! value for the output {\tt INTEGER} flag {\tt status}. 
+!
+! {\bf N.B.}:  This routine assumes that the {\tt GeneralGrid} argument
+! {\tt oGGrid} is uninitialized on input; that is, all the {\tt List} 
+! components are blank, the {\tt LOGICAL} array {\tt oGGrid\%descend} is
+! unallocated, and the {\tt AttrVect} component {\tt oGGrid\%data} is
+! uninitialized.  The {\tt GeneralGrid} {\tt oGGrid} represents allocated
+! memory.  When the user no longer needs {\tt oGGrid}, it should be 
+! deallocated by invoking {\tt GeneralGrid\_clean()} (see 
+! {\tt m\_GeneralGrid} for further details).
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! between {\tt TagBase} and {\tt TagBase+20}, inclusive.  This is 
+! because {\tt recv\_()} performs one receive operation set up the header
+! transfer, up to five {\tt List\_recv} operations (two {\tt MPI\_RECV} 
+! calls in each), two receive operations to transfer {\tt iGGrid\%descend(:)},
+! and finally the receive of the {\tt AttrVect} component {\tt iGGrid\%data} 
+! (which comprises eight {\tt MPI\_RECV} operations).
+!
+! !INTERFACE:
+
+ subroutine recv_(oGGrid, comp_id, TagBase, status)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      use m_MCTWorld, only : ComponentToWorldRank
+      use m_MCTWorld, only : ThisMCTWorld
+
+      use m_AttrVectComms,only : AttrVect_recv => recv
+
+      use m_List,only : List_recv => recv
+      use m_List,only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,           intent(in) :: comp_id
+      integer,           intent(in) :: TagBase
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(out) :: oGGrid
+      integer, optional, intent(out) :: status
+
+! !REVISION HISTORY:
+!       04Jun01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       07Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!       10Jun01 - J.W. Larson <larson@mcs.anl.gov> - Bug fixes--now works.
+!       11Jun01 - R. Jacob <jacob@mcs.anl.gov> use component id as input
+!                 argument.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!                 (if present).
+!       13Jun02 - J.W. Larson <larson@mcs.anl.gov> - Removed the argument
+!                 comm.  This routine is now explicitly for intercomponent
+!                 communications only.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::recv_'
+
+  integer :: ierr
+  integer :: source
+  integer :: MPstatus(MP_STATUS_SIZE), DescendSize
+  logical :: HeaderAssoc(6)
+
+! for now, assume the components root is the source.
+  source = ComponentToWorldRank(0, comp_id, ThisMCTWorld)
+
+      ! Step 1. Receive the elements of the LOGICAL flag array
+      ! HeaderAssoc.  TRUE entries in this array correspond to
+      ! Check elements of the GeneralGrid header that are not
+      ! blank, and are being sent by process source.
+      !      
+      ! The significance of the entries of HeaderAssoc has been
+      ! defined in send_().  Here are the definitions of these
+      ! values:
+      !
+      !  HeaderAssoc(1) = List_allocated(oGGrid%coordinate_list)
+      !  HeaderAssoc(2) = List_allocated(oGGrid%coordinate_sort_order)
+      !  HeaderAssoc(3) = associated(oGGrid%descend)
+      !  HeaderAssoc(4) = List_allocated(oGGrid%weight_list)
+      !  HeaderAssoc(5) = List_allocated(oGGrid%other_list)
+      !  HeaderAssoc(6) = List_allocated(oGGrid%index_list)
+
+      ! Initialize status (if present)
+
+  if(present(status)) status = 0
+
+      ! Step 1.  Nullify oGGrid components, set HeaderAssoc(:) to .FALSE., 
+      ! then receive incoming HeaderAssoc(:) data
+
+  call List_nullify(oGGrid%coordinate_list)
+  call List_nullify(oGGrid%coordinate_sort_order)
+  call List_nullify(oGGrid%weight_list)
+  call List_nullify(oGGrid%other_list)
+  call List_nullify(oGGrid%index_list)
+  nullify(oGGrid%descend)
+
+  HeaderAssoc = .FALSE.
+
+  call MPI_RECV(HeaderAssoc, 6, MP_LOGICAL, source, TagBase, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,':: MPI_RECV(HeaderAssoc...',ierr)
+  endif
+
+       ! Step 2.  If oGGrid%coordinate_list is defined, receive it.
+
+  if(HeaderAssoc(1)) then
+    call List_recv(oGGrid%coordinate_list, source, TagBase+1, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_recv(oGGrid%coordinate_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_recv(oGGrid%coordinate_list...',ierr)
+       endif
+    endif
+  else  ! This constitutes an error, as a GeneralGrid must have coordinates
+
+     if(present(status)) then
+	write(stderr,*) myname_,':: Error.  GeneralGrid%coordinate_list undefined.'
+	status = -1
+	return
+     else
+	call die(myname_,'::  Error.  GeneralGrid%coordinate_list undefined.',-1)
+     endif
+
+  endif ! if(HeaderAssoc(1))...
+
+       ! Step 3.  If oGGrid%coordinate_sort_order is defined, receive it.
+
+  if(HeaderAssoc(2)) then
+     call List_recv(oGGrid%coordinate_sort_order, source, TagBase+3, ThisMCTWorld%MCT_comm, ierr)
+     if(ierr /= 0) then
+	if(present(status)) then
+	   write(stderr,*) myname_,':: Error calling ',&
+		'List_recv(oGGrid%coordinate_sort_order...'
+	   status = ierr
+	   return
+	else
+	   call die(myname_,':: call List_recv(oGGrid%coordinate_sort_order...', ierr)
+	endif
+     endif
+  endif ! if(HeaderAssoc(2))...
+
+       ! Step 4.  If oGGrid%descend is allocated, determine its size,
+       ! receive this size, allocate oGGrid%descend, and then receive 
+       ! the elements of oGGrid%descend.
+     
+  if(HeaderAssoc(3)) then
+
+     call MPI_RECV(DescendSize, 1, MP_type(DescendSize), &
+                   source, TagBase+5, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+     if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_RECV(size(oGGrid%descend)...',ierr)
+     endif
+
+     allocate(oGGrid%descend(DescendSize), stat=ierr)
+     if(ierr /= 0) then
+	if(present(status)) then
+	   write(stderr,*) myname_,':: allocate(oGGrid%descend...'
+	   status = ierr
+	   return
+	else
+	   call die(myname_,':: allocate(oGGrid%descend... failed.',ierr)
+	endif
+     endif
+
+     call MPI_RECV(oGGrid%descend, DescendSize, MP_type(oGGrid%descend(1)), &
+                   source, TagBase+6, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+     if(ierr /= 0) then
+	   call MP_perr_die(myname_,':: call MPI_RECV(oGGrid%descend...',ierr)
+     endif
+
+  endif ! if(HeaderAssoc(3))...
+
+       ! Step 5.  If oGGrid%weight_list is defined, receive it.
+
+  if(HeaderAssoc(4)) then
+
+    call List_recv(oGGrid%weight_list, source, TagBase+7, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_recv(oGGrid%weight_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_recv(oGGrid%weight_list...',ierr)
+       endif
+    endif
+
+  endif ! if(HeaderAssoc(4))...
+
+       ! Step 6.  If oGGrid%other_list is defined, receive it.
+
+  if(HeaderAssoc(5)) then
+
+    call List_recv(oGGrid%other_list, source, TagBase+9, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_recv(oGGrid%other_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_recv(oGGrid%other_list...',ierr)
+       endif
+    endif
+
+  endif ! if(HeaderAssoc(5))...
+
+       ! Step 7.  If oGGrid%index_list is defined, receive it.
+
+  if(HeaderAssoc(6)) then
+
+    call List_recv(oGGrid%index_list, source, TagBase+11, ThisMCTWorld%MCT_comm, ierr)
+    if(ierr /= 0) then
+       if(present(status)) then
+          write(stderr,*) myname_,':: call List_recv(oGGrid%index_list...'
+          status = ierr
+          return
+       else
+          call die(myname_,':: call List_recv(oGGrid%index_list...',ierr)
+       endif
+    endif
+
+  else  ! This constitutes an error, as a GeneralGrid must at a minimum
+        ! contain the index GlobGridNum
+
+     if(present(status)) then
+	write(stderr,*) myname_,':: Error.  GeneralGrid%index_list undefined.'
+	status = -2
+	return
+     else
+	call die(myname_,'::  Error.  GeneralGrid%index_list undefined.',-2)
+     endif
+
+  endif ! if(HeaderAssoc(6))...
+
+       ! Step 8.  Finally, receive the AttrVect oGGrid%data.
+
+  call AttrVect_recv(oGGrid%data, source, TagBase+13, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+	write(stderr,*) myname_,':: call AttrVect_recv(oGGrid%data...'
+	status = ierr
+	return
+     else
+	call die(myname_,':: call AttrVect_recv(oGGrid%data...',ierr)
+     endif
+  endif
+
+       ! The GeneralGrid receive is now complete.
+
+ end subroutine recv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_gather_ - gather a GeneralGrid using input GlobalMap.
+!
+! !DESCRIPTION:  {\tt GM\_gather\_()} takes an input {\tt GeneralGrid} 
+! argument {\tt iG} whose decomposition on the communicator associated 
+! with the F90 handle {\tt comm} is described by the {\tt GlobalMap} 
+! argument {\tt GMap}, and gathers it to the {\tt GeneralGrid} output
+! argument {\tt oG} on the {\tt root}.  The success (failure) of this 
+! operation is reported as a zero (nonzero) value in the optional 
+! {\tt INTEGER} output argument {\tt stat}.
+
+! {\bf N.B.}:  An important assumption made here is that the distributed
+! {\tt GeneralGrid} {\tt iG} has been initialized with the same 
+! coordinate system, sort order, other real attributes, and the same 
+! indexing attributes for all processes on {\tt comm}.
+!
+! {\bf N.B.}:  Once the gridpoint data of the {\tt GeneralGrid} are assembled 
+! on the {\tt root}, they are stored in the order determined by the input 
+! {\tt GlobalMap} {\tt GMap}.  The user may need to sorted these gathered
+! data to order them in  accordance with the {\tt coordinate\_sort\_order} 
+! attribute of {\tt iG}.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt oG} represents allocated
+! memory on the {\tt root}.  When the user no longer needs {\tt oG} it
+! should be deallocated using {\tt GeneralGrid\_clean()} to avoid a memory
+! leak
+!
+! !INTERFACE:
+!
+ subroutine GM_gather_(iG, oG, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_gsize => gsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+
+      use m_AttrVectComms,only : AttrVect_Gather => gather
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: iG
+      type(GlobalMap),   intent(in)  :: GMap
+      integer,           intent(in)  :: root
+      integer,           intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(out) :: oG
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       02May01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::GM_gather_'
+!Process ID
+ integer :: myID
+!Error flag
+ integer :: ierr
+!Number of points on the _Gathered_ grid:
+ integer :: length
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+    call MP_perr_die(myname_,'call MPI_COMM_RANK()',ierr)
+  endif
+
+  if(myID == root) then ! prepare oG:
+
+       ! The length of the _gathered_ GeneralGrid oG is determined by 
+       ! the GlobalMap function GlobalMap_gsize()
+
+     length = GlobalMap_gsize(GMap)
+
+       ! Initialize attributes of oG from iG
+     call copyGeneralGridHeader_(iG,oG) 
+
+  endif
+
+       ! Gather gridpoint data in iG%data to oG%data
+
+  call AttrVect_Gather(iG%data, oG%data, GMap, root, comm, ierr)
+
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error--call AttrVect_Gather() failed.', &
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat=ierr
+	return
+     else
+	call die(myname_,'call AttrVect_Gather(ig%data...',ierr)
+     endif
+  endif
+
+ end subroutine GM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_gather_ - gather a GeneralGrid using input GlobalSegMap.
+!
+! !DESCRIPTION:  {\tt GMS\_gather\_()} takes an input {\tt GeneralGrid} 
+! argument {\tt iG} whose decomposition on the communicator associated 
+! with the F90 handle {\tt comm} is described by the {\tt GlobalSegMap} 
+! argument {\tt GSMap}, and gathers it to the {\tt GeneralGrid} output
+! argument {\tt oG} on the {\tt root}.  The success (failure) of this 
+! operation is reported as a zero (nonzero) value in the optional 
+! {\tt INTEGER} output argument {\tt stat}.
+!
+! {\bf N.B.}:  An important assumption made here is that the distributed
+! {\tt GeneralGrid} {\tt iG} has been initialized with the same 
+! coordinate system, sort order, other real attributes, and the same 
+! indexing attributes for all processes on {\tt comm}.
+!
+! {\bf N.B.}:  Once the gridpoint data of the {\tt GeneralGrid} are assembled 
+! on the {\tt root}, they are stored in the order determined by the input 
+! {\tt GlobalSegMap} {\tt GSMap}.  The user may need to sorted these gathered
+! data to order them in  accordance with the {\tt coordinate\_sort\_order} 
+! attribute of {\tt iG}.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt oG} represents allocated
+! memory on the {\tt root}.  When the user no longer needs {\tt oG} it
+! should be deallocated using {\tt GeneralGrid\_clean()} to avoid a memory
+! leak
+!
+! !INTERFACE:
+
+ subroutine GSM_gather_(iG, oG, GSMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      use m_AttrVectComms,only : AttrVect_Gather => gather
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),  intent(in)  :: iG
+      type(GlobalSegMap), intent(in)  :: GSMap
+      integer,            intent(in)  :: root
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid),  intent(out) :: oG
+      integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       01May01 - J.W. Larson <larson@mcs.anl.gov> - Working Version.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GSM_gather_'
+
+!Process ID
+ integer :: myID
+!Error flag
+ integer :: ierr
+!Number of points on the _Gathered_ grid:
+ integer :: length
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+    call MP_perr_die(myname_,'MPI_COMM_RANK()',ierr)
+  endif
+
+  if(myID == root) then ! prepare oG:
+
+       ! The length of the _gathered_ GeneralGrid oG is determined by 
+       ! the GlobalMap function GlobalSegMap_gsize()
+
+     length = GlobalSegMap_gsize(GSMap)
+
+       ! Initialize attributes of oG from iG
+     call copyGeneralGridHeader_(iG,oG) 
+
+  endif
+
+       ! Gather gridpoint data in iG%data to oG%data
+
+  call AttrVect_Gather(iG%data, oG%data, GSMap, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: ERROR--call AttrVect_Gather() failed.', &
+	  ' ierr = ',ierr
+    if(present(stat)) then
+       stat=ierr
+       return
+    else
+       call die(myname_)
+    endif
+  endif
+
+ end subroutine GSM_gather_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GM_scatter_ - scatter a GeneralGrid using input GlobalMap.
+!
+! !DESCRIPTION:  {\tt GM\_scatter\_()} takes an input {\tt GeneralGrid} 
+! argument {\tt iG} (valid only on the {\tt root} process), and scatters 
+! it to the distributed {\tt GeneralGrid} variable {\tt oG}.  The 
+! {\tt GeneralGrid} {\tt oG} is distributed on the communicator 
+! associated with the F90  handle {\tt comm} using the domain 
+! decomposition described by the {\tt GlobalMap} argument {\tt GMap}.
+! The success (failure) of this operation is reported as a zero (nonzero) 
+! value in the optional {\tt INTEGER} output argument {\tt stat}.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt oG} represents allocated
+! memory on the {\tt root}.  When the user no longer needs {\tt oG} it
+! should be deallocated using {\tt GeneralGrid\_clean()} to avoid a memory
+! leak.
+!
+! !INTERFACE:
+
+ subroutine GM_scatter_(iG, oG, GMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalMap, only : GlobalMap
+      use m_GlobalMap, only : GlobalMap_lsize => lsize
+      use m_GlobalMap, only : GlobalMap_gsize => gsize
+
+      use m_AttrVectComms, only : AttrVect_scatter => scatter
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: iG
+      type(GlobalMap),   intent(in)  :: GMap
+      integer,           intent(in)  :: root
+      integer,           intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(out) :: oG
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       04Jun01 - J.W. Larson <larson@mcs.anl.gov> - Changed comms model
+!                 to MPI-style (i.e. iG valid on root only).
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GM_scatter_'
+
+  logical :: DescendAssoc
+  integer :: DescendSize
+  integer :: ierr, myID
+
+      ! Initialize status (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Step 1.  Determine process ID number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK(comm...',ierr)
+  endif
+
+       ! Step 2.  On the root, initialize the List and LOGICAL 
+       ! attributes of the GeneralGrid variable iG to oG.
+
+  if(myID == root) then
+     call copyGeneralGridHeader_(iG, oG)
+  endif
+
+       ! Step 3.  Broadcast from the root the List and LOGICAL 
+       ! attributes of the GeneralGrid variable oG.
+
+  call bcastGeneralGridHeader_(oG, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling bcastGeneralGridHeader_().',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_,'call bcastGeneralGridHeader_(oG...',ierr)
+     endif
+  endif
+
+
+       ! Step 4.  Using the GeneralMap GMap, scatter the AttrVect 
+       ! portion of the input GeneralGrid iG to the GeneralGrid oG.
+
+  call AttrVect_scatter(iG%data, oG%data, GMap, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling AttrVect_scatter(iG%data...',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_,'call AttrVect_scatter(iG%data...',ierr)
+     endif
+  endif
+
+       ! The GeneralGrid scatter is now complete.
+
+ end subroutine GM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GSM_scatter_ - scatter a GeneralGrid using input GlobalSegMap.
+!
+! !DESCRIPTION:  {\tt GM\_scatter\_()} takes an input {\tt GeneralGrid} 
+! argument {\tt iG} (valid only on the {\tt root} process), and scatters 
+! it to the distributed {\tt GeneralGrid} variable {\tt oG}.  The 
+! {\tt GeneralGrid} {\tt oG} is distributed on the communicator 
+! associated with the F90  handle {\tt comm} using the domain 
+! decomposition described by the {\tt GlobalSegMap} argument {\tt GSMap}.
+! The success (failure) of this operation is reported as a zero (nonzero) 
+! value in the optional {\tt INTEGER} output argument {\tt stat}.
+!
+! {\bf N.B.}:  The output {\tt GeneralGrid} {\tt oG} represents allocated
+! memory on the {\tt root}.  When the user no longer needs {\tt oG} it
+! should be deallocated using {\tt GeneralGrid\_clean()} to avoid a memory
+! leak.
+!
+! !INTERFACE:
+
+ subroutine GSM_scatter_(iG, oG, GSMap, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+
+      use m_AttrVectComms, only : AttrVect_scatter => scatter
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid),  intent(in)  :: iG
+      type(GlobalSegMap), intent(in)  :: GSMap
+      integer,            intent(in)  :: root
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid),  intent(out) :: oG
+      integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       04Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GSM_scatter_'
+
+  integer :: ierr, myID
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Step 1.  Determine process ID number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK(comm...',ierr)
+  endif
+
+       ! Step 2.  On the root, initialize the List and LOGICAL 
+       ! attributes of the GeneralGrid variable iG to oG.
+
+  if(myID == root) then
+     call copyGeneralGridHeader_(iG, oG)
+  endif
+
+       ! Step 3.  Broadcast from the root the List and LOGICAL 
+       ! attributes of the GeneralGrid variable oG.
+
+  call bcastGeneralGridHeader_(oG, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling bcastGeneralGridHeader_(...',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_,'bcastGeneralGridHeader_(oG...',ierr)
+     endif
+  endif
+
+       ! Step 4.  Using the GeneralSegMap GSMap, scatter the AttrVect 
+       ! portion of the input GeneralGrid iG to the GeneralGrid oG.
+
+  call AttrVect_scatter(iG%data, oG%data, GSMap, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling AttrVect_scatter(iG%data...',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_,'call AttrVect_scatter(iG%data...',ierr)
+     endif
+  endif
+
+       ! The GeneralGrid scatter is now complete.
+
+ end subroutine GSM_scatter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - Broadcast a GeneralGrid.
+!
+! !DESCRIPTION:  {\tt bcast\_()} takes an input {\tt GeneralGrid} 
+! argument {\tt ioG} (valid only on the {\tt root} process), and 
+! broadcasts it to all processes on the communicator associated with the 
+! F90  handle {\tt comm}.  The success (failure) of this operation is 
+! reported as a zero (nonzero) value in the optional {\tt INTEGER} 
+! output argument {\tt stat}.
+!
+! {\bf N.B.}:  On the non-root processes, the output {\tt GeneralGrid} 
+! {\tt ioG} represents allocated memory.  When the user no longer needs 
+! {\tt ioG} it should be deallocated by invoking {\tt GeneralGrid\_clean()}. 
+! Failure to do so risks a memory leak.
+!
+! !INTERFACE:
+
+ subroutine bcast_(ioG, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      use m_AttrVectComms,only : AttrVect_bcast => bcast
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,           intent(in)    :: root
+      integer,           intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(inout) :: ioG
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+!       27Apr01 - J.W. Larson <larson@mcs.anl.gov> - API Specification.
+!       02May01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcast_'
+
+  integer :: ierr, myID
+
+      ! Initialize status (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Step 1.  Determine process ID number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK(comm...',ierr)
+  endif
+
+       ! Step 2.  Broadcast from the root the List and LOGICAL 
+       ! attributes of the GeneralGrid variable ioG.
+
+  call bcastGeneralGridHeader_(ioG, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling bcastGeneralGridHeader_(...',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_)
+     endif
+  endif
+
+       ! Step 3.  Broadcast ioG%data from the root.
+
+  call AttrVect_bcast(ioG%data, root, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,*) myname_,':: Error calling AttrVect_scatter(iG%data...',&
+	  ' ierr = ',ierr
+     if(present(stat)) then
+	stat = ierr
+	return
+     else
+	call die(myname_)
+     endif
+  endif
+
+       ! The GeneralGrid broadcast is now complete.
+
+ end subroutine bcast_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcastGeneralGridHeader_ - Broadcast the GeneralGrid Header.
+!
+! !DESCRIPTION:  This routine broadcasts the header information from 
+! the input {\tt GeneralGrid} argument {\tt ioGGrid} (on input valid 
+! on the {\tt root} only).  This broadcast is from the {\tt root} to 
+! all processes on the communicator associated with the fortran 90 
+! {\tt INTEGER} handle {\tt comm}.  The success (failure) of this operation 
+! corresponds to a zero (nonzero) value for the output {\tt INTEGER} flag 
+! {\tt stat}. 
+!
+! The {\em header information} in a {\tt GeneralGrid} variable comprises 
+! all the non-{\tt AttrVect} components of the {\tt GeneralGrid}; that 
+! is, everything except the gridpoint coordinate, geometry, and index 
+! data stored in {\tt iGGrid\%data}.  This information includes:
+! \begin{enumerate}
+! \item The coordinates in {\tt iGGrid\%coordinate\_list}
+! \item The coordinate sort order in {\tt iGGrid\%coordinate\_sort\_order}
+! \item The area/volume weights in {\tt iGGrid\%weight\_list}
+! \item Other {\tt REAL} geometric information in {\tt iGGrid\%other\_list}
+! \item Indexing information in {\tt iGGrid\%index\_list}
+! \item The {\tt LOGICAL} descending/ascending order sort flags in 
+! {\tt iGGrid\%descend(:)}.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ subroutine bcastGeneralGridHeader_(ioGGrid, root, comm, stat)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_init => init
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+      use m_List, only : List_nullify => nullify
+      use m_List, only : List_bcast => bcast
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,           intent(in)    :: root
+      integer,           intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(inout) :: ioGGrid
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+!       05Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+!       13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize stat
+!                 (if present).
+!       05Aug02 - E. Ong <eong@mcs.anl.gov> - added association checking
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcastGeneralGridHeader_'
+
+! Process ID
+  integer :: myID
+! Error flag
+  integer :: ierr
+! Size of array ioGGrid%descend(:)
+  integer :: DescendSize
+! Header-Assocation array
+  logical :: HeaderAssoc(6)
+
+      ! Initialize stat (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Determine process ID number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK(comm...',ierr)
+  endif
+
+       ! Step 0.5. Check elements of the GeneralGrid header to see 
+       ! which components of it are allocated.  Load the results
+       ! into HeaderAssoc(:), and broadcast it.
+
+  if(myID == root) then
+
+     HeaderAssoc(1) = List_allocated(ioGGrid%coordinate_list)
+     HeaderAssoc(2) = List_allocated(ioGGrid%coordinate_sort_order)
+     HeaderAssoc(3) = List_allocated(ioGGrid%weight_list)
+     HeaderAssoc(4) = List_allocated(ioGGrid%other_list)
+     HeaderAssoc(5) = List_allocated(ioGGrid%index_list)
+     HeaderAssoc(6) = associated(ioGGrid%descend)
+
+  else
+
+     call List_nullify(ioGGrid%coordinate_list)
+     call List_nullify(ioGGrid%coordinate_sort_order)
+     call List_nullify(ioGGrid%weight_list)
+     call List_nullify(ioGGrid%other_list)
+     call List_nullify(ioGGrid%index_list)
+     nullify(ioGGrid%descend) 
+
+  endif
+
+  call MPI_BCAST(HeaderAssoc,6,MP_LOGICAL,root,comm,ierr)
+
+       ! Step 1. Broadcast List attributes of the GeneralGrid.
+
+  if(HeaderAssoc(1)) then
+     call List_bcast(ioGGrid%coordinate_list, root, comm, ierr)
+     if(ierr /= 0) then
+        write(stderr,*) myname_,'List_bcast(ioGGrid%coordinate_list... failed.',&
+             ' ierr = ',ierr
+        if(present(stat)) then
+           stat = ierr
+           return
+        else
+           call die(myname_)
+        endif
+     endif
+  endif
+
+  if(HeaderAssoc(2)) then
+     call List_bcast(ioGGrid%coordinate_sort_order, root, comm, ierr)
+     if(ierr /= 0) then
+        write(stderr,*) myname_,'List_bcast(ioGGrid%coordinate_sort_order... failed', &
+             ' ierr = ',ierr
+        if(present(stat)) then
+           stat = ierr
+           return
+        else
+           call die(myname_)
+        endif
+     endif
+  endif
+
+  if(HeaderAssoc(3)) then
+     call List_bcast(ioGGrid%weight_list, root, comm, ierr)
+     if(ierr /= 0) then
+        write(stderr,*) myname_,'List_bcast(ioGGrid%weight_list... failed',&
+             ' ierr = ',ierr
+        if(present(stat)) then
+           stat = ierr
+           return
+        else
+           call die(myname_)
+        endif
+     endif
+  endif
+
+  if(HeaderAssoc(4)) then
+     call List_bcast(ioGGrid%other_list, root, comm, ierr)
+     if(ierr /= 0) then
+        write(stderr,*) myname_,'List_bcast(ioGGrid%other_list... failed',&
+             ' ierr = ',ierr
+        if(present(stat)) then
+           stat = ierr
+           return
+        else
+           call die(myname_)
+        endif
+     endif
+  endif
+
+  if(HeaderAssoc(5)) then
+     call List_bcast(ioGGrid%index_list, root, comm, ierr)
+     if(ierr /= 0) then
+        write(stderr,*) myname_,'List_bcast(ioGGrid%index_list... failed',&
+             ' ierr = ',ierr
+        if(present(stat)) then
+           stat = ierr
+           return
+        else
+           call die(myname_)
+        endif
+     endif
+  endif
+
+       ! If ioGGrid%descend is associated on the root, prepare and
+       ! execute its broadcast
+
+  if(HeaderAssoc(6)) then
+
+       ! On the root, get the size of ioGGrid%descend(:)
+
+     if(myID == root) then
+        DescendSize = size(ioGGrid%descend)
+        if(DescendSize<=0) call die(myname_,'size(ioGGrid%descend)<=0')
+     endif
+
+       ! Broadcast the size of ioGGrid%descend(:) from the root.
+
+     call MPI_BCAST(DescendSize, 1, MP_INTEGER, root, comm, ierr)
+     if(ierr /= 0) then
+        call MP_perr_die(myname_,'MPI_BCAST(DescendSize...',ierr)
+     endif
+
+       ! Off the root, allocate ioGGrid%descend(:)
+
+     if(myID /= root) then
+        allocate(ioGGrid%descend(DescendSize), stat=ierr)
+        if(ierr /= 0) then
+           write(stderr,*) myname_,':: ERROR in allocate(ioGGrid%descend...',&
+                ' ierr = ',ierr
+           call die(myname_)
+        endif
+     endif
+ 
+      ! Finally, broadcast ioGGrid%descend(:) from the root
+
+     call MPI_BCAST(ioGGrid%descend, DescendSize, MP_LOGICAL, root, &
+                    comm, ierr)
+     if(ierr /= 0) then
+        call MP_perr_die(myname_,'MPI_BCAST(ioGGrid%descend...',ierr)
+     endif
+
+  endif
+
+       ! The broadcast of the GeneralGrid Header from the &
+       ! root is complete.
+
+
+ end subroutine bcastGeneralGridHeader_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: copyGeneralGridHeader_ - Copy the GeneralGrid Header.
+!
+! !DESCRIPTION:  This routine copies the header information from the 
+! input {\tt GeneralGrid} argument {\tt iGGrid} to the output 
+! {\tt GeneralGrid} argument {\tt oGGrid}.  The {\em header information} 
+! in a {\tt GeneralGrid} variable comprises all the non-{\tt AttrVect} 
+! components of the {\tt GeneralGrid}; that is, everything except the 
+! gridpoint coordinate, geometry, and index data stored in 
+! {\tt iGGrid\%data}.  This information includes:
+! \begin{enumerate}
+! \item The coordinates in {\tt iGGrid\%coordinate\_list}
+! \item The coordinate sort order in {\tt iGGrid\%coordinate\_sort\_order}
+! \item The area/volume weights in {\tt iGGrid\%weight\_list}
+! \item Other {\tt REAL} geometric information in {\tt iGGrid\%other\_list}
+! \item Indexing information in {\tt iGGrid\%index\_list}
+! \item The {\tt LOGICAL} descending/ascending order sort flags in 
+! {\tt iGGrid\%descend(:)}.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ subroutine copyGeneralGridHeader_(iGGrid, oGGrid)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_List, only : List
+      use m_List, only : List_copy => copy
+      use m_List, only : List_allocated => allocated
+      use m_List, only : List_nullify => nullify
+
+      use m_GeneralGrid, only : GeneralGrid
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(in)  :: iGGrid
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GeneralGrid), intent(out) :: oGGrid
+
+! !REVISION HISTORY:
+!       05Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+!       08Aug01 - E.T. Ong <eong@mcs.anl.gov> - changed list assignments(=)
+!                 to list copy.
+!       05Aug02 - E. Ong <eong@mcs.anl.gov> - added association checking
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::copyGeneralGridHeader_'
+
+  logical :: DescendAssoc
+  integer :: DescendSize, i, ierr
+
+       ! Step 1. Copy GeneralGrid List attributes from iGGrid 
+       ! to oGGrid.
+
+  call List_nullify(oGGrid%coordinate_list)
+  call List_nullify(oGGrid%coordinate_sort_order)
+  call List_nullify(oGGrid%weight_list)
+  call List_nullify(oGGrid%other_list)
+  call List_nullify(oGGrid%index_list)
+  nullify(oGGrid%descend)
+
+  if(List_allocated(iGGrid%coordinate_list)) then
+     call List_copy(oGGrid%coordinate_list,iGGrid%coordinate_list)
+  endif
+
+  if(List_allocated(iGGrid%coordinate_sort_order)) then
+     call List_copy(oGGrid%coordinate_sort_order,iGGrid%coordinate_sort_order)
+  endif
+
+  if(List_allocated(iGGrid%weight_list)) then
+     call List_copy(oGGrid%weight_list,iGGrid%weight_list)
+  endif
+
+  if(List_allocated(iGGrid%other_list)) then
+     call List_copy(oGGrid%other_list,iGGrid%other_list)
+  endif
+
+  if(List_allocated(iGGrid%index_list)) then
+     call List_copy(oGGrid%index_list,iGGrid%index_list)
+  endif
+
+  DescendAssoc = associated(iGGrid%descend) 
+  if(DescendAssoc) then
+
+     DescendSize = size(iGGrid%descend)
+     allocate(oGGrid%descend(DescendSize), stat=ierr)
+     if(ierr /= 0) then 
+	write(stderr,*) myname_,':: ERROR--allocate(iGGrid%descend(... failed.',&
+	     ' ierr = ', ierr, 'DescendSize = ', DescendSize
+        call die(myname_)
+     endif
+     do i=1,DescendSize
+	oGGrid%descend(i) = iGGrid%descend(i)
+     end do
+
+  endif
+
+       ! The GeneralGrid header copy is now complete.
+
+ end subroutine copyGeneralGridHeader_
+
+ end module m_GeneralGridComms
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalMap.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalMap.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalMap.F90	(revision 4775)
@@ -0,0 +1,672 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GlobalMap.F90,v 1.11 2004-04-21 22:47:09 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GlobalMap - One-Dimensional Domain Decomposition Descriptor
+!
+! !DESCRIPTION:
+! The {\tt GlobalMap} is a datatype used to store descriptors of a 
+! one-dimensional domain decomposition for a vector on an MPI communicator.  
+! It is defined with three assumptions:
+! \begin{enumerate}
+! \item Each process ID owns only one segment;
+! \item No two segments in the decomposition overlap; and
+! \item The segments are laid out in identical order to the MPI rank of 
+! each process participating in the decomposition.
+! \end{enumerate}
+! per process ID).  It is the simpler of the two domain decomposition 
+! descriptors offerd by MCT (the other being the {\tt GlobalSegMap}).  
+! It consists of the following components:
+! \begin{itemize}
+! \item The MCT component identification number (see the module 
+! {\tt m\_MCTWorld} for more information about MCT's component model 
+! registry);
+! \item The {\em global} number of elements in the distributed vector;
+! \item The number of elements {\em stored locally};
+! \item The number of elements {\em stored on each process} on the 
+! communicator over which the vector is distributed; and
+! \item The index of the elemnent {\em immediately before} the starting 
+! element of each local segment (this choice allows for direct use of 
+! this information with MPI's scatter and gather operations).  We refer 
+! to this quantity as the {\em displacement} of the segment, a term used 
+! both here and in the definition of the MCT {\tt Navigator} datatype.
+! \end{itemize}
+!
+! Both the segment displacement and length data are stored in arrays 
+! whose indices run from zero to $N-1$, where $N$ is the number of MPI 
+! processes on the communicator on which the {\tt GlobalMap} is defined.
+! This is done so this information corresponds directly to the MPI process 
+! ID's on whihc the segments reside.
+!
+! This module contains the definition of the {\tt GlobalMap} datatype, 
+! all-processor and an on-root creation methods (both of which can be 
+! used to create a {\tt GlobalMap} on the local communicator), a creation 
+! method to create/propagate a {\tt GlobalMap} native to a remote 
+! communicator, a destruction method, and a variety of query methods.
+! 
+! !INTERFACE:
+
+ module m_GlobalMap
+
+! !USES
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: GlobalMap		! The class data structure
+
+    Type GlobalMap
+      integer :: comp_id                        ! Component ID number
+      integer :: gsize				! the Global size
+      integer :: lsize				! my local size
+      integer,dimension(:),pointer :: counts	! all local sizes
+      integer,dimension(:),pointer :: displs	! PE ordered locations
+    End Type GlobalMap
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: gsize
+      public :: lsize
+      public :: init
+      public :: init_remote
+      public :: clean
+      public :: rank
+      public :: bounds
+      public :: comp_id
+
+    interface gsize; module procedure gsize_; end interface
+    interface lsize; module procedure lsize_; end interface
+    interface init ; module procedure	&
+       initd_,	&	! initialize from all PEs
+       initr_		! initialize from the root
+    end interface
+    interface init_remote; module procedure init_remote_; end interface
+    interface clean; module procedure clean_; end interface
+    interface rank ; module procedure rank_ ; end interface
+    interface bounds; module procedure bounds_; end interface
+    interface comp_id ; module procedure comp_id_ ; end interface
+
+! !SEE ALSO:
+! The MCT module m_MCTWorld for more information regarding component 
+! ID numbers.
+!
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!  9Nov00 - J.W. Larson <larson@mcs.anl.gov> - added init_remote
+!           interface.
+! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - added storage for
+!           component ID number GlobalMap%comp_id, and associated
+!           method comp_id_()
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_GlobalMap'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initd_ - Collective Creation on the Local Communicator
+!
+! !DESCRIPTION:
+! This routine creates the {\tt GlobalMap} {\tt GMap} from distributed 
+! data spread across the MPI communicatior associated with the input 
+! {\tt INTEGER} handle {\tt comm}.  The {\tt INTEGER} input argument 
+! {\tt comp\_id} is used to define the MCT component ID for {\tt GMap}.
+! The input {\tt INTEGER} argument {\tt ln} is the number of elements 
+! in the local vector segment.
+!
+! !INTERFACE:
+
+ subroutine initd_(GMap, comp_id, ln, comm)
+
+! !USES:
+
+      use m_mpif90
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,         intent(in)  :: comp_id ! Component ID
+      integer,         intent(in)  :: ln      ! the local size
+      integer,         intent(in)  :: comm    ! f90 MPI communicator 
+                                              ! handle 
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalMap), intent(out) :: GMap
+
+! !SEE ALSO:
+! The MCT module m_MCTWorld for more information regarding component 
+! ID numbers.
+!
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initd_'
+  integer :: nPEs,myID,ier,l,i
+
+  call MP_comm_size(comm,nPEs,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+  allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier)
+  if(ier /= 0) call die(myname_,'allocate()',ier)
+
+#ifdef MALL_ON
+	call mall_ci(size(transfer(GMap%counts,(/1/))),myname_)
+	call mall_ci(size(transfer(GMap%displs,(/1/))),myname_)
+#endif
+
+  call MPI_allgather(ln,1,MP_INTEGER,GMap%counts,1,MP_INTEGER,comm,ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_allgather()',ier)
+
+  l=0
+  do i=0,nPEs-1
+    GMap%displs(i)=l
+    l=l+GMap%counts(i)
+  end do
+
+  GMap%lsize=GMap%counts(myID)	! the local size
+  GMap%gsize=l	! the global size
+  GMap%comp_id = comp_id ! the component ID number
+
+ end subroutine initd_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initr_ Create a GlobalMap from the Root Process
+!
+! !DESCRIPTION:
+! This routine creates the {\tt GlobalMap} {\tt GMap}, and propagates 
+! it to all processes on the communicator associated with the MPI 
+! {\tt INTEGER} handle {\tt comm}.  The input {\tt INTEGER} arguments 
+! {\tt comp\_id} (the MCT component ID number) and {\tt lns(:)} need 
+! only be valid on the process whose rank is equal to {\tt root} on 
+! {\tt comm}.  The array {\tt lns(:)} should have length equal to the 
+! number of processes on {\tt comm}, and contains the length of each
+! local segment.
+!
+! !INTERFACE:
+
+ subroutine initr_(GMap, comp_id, lns, root, comm)
+
+! !USES:
+
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,               intent(in)  :: comp_id ! component ID number
+      integer, dimension(:), intent(in)  :: lns     ! segment lengths
+      integer,               intent(in)  :: root    ! root process ID
+      integer,               intent(in)  :: comm    ! communicator ID
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalMap),       intent(out) :: GMap
+
+! !SEE ALSO:
+! The MCT module m_MCTWorld for more information regarding component 
+! ID numbers.
+!
+! !REVISION HISTORY:
+! 29May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initr_'
+  integer :: nPEs,myID,ier,l,i
+
+  call MP_comm_size(comm,nPEs,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+  allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier)
+  if(ier /= 0) call die(myname_,'allocate()',ier)
+
+#ifdef MALL_ON
+	call mall_ci(size(transfer(GMap%counts,(/1/))),myname_)
+	call mall_ci(size(transfer(GMap%displs,(/1/))),myname_)
+#endif
+
+  if(myID == root) then
+    if(size(lns(:)) /= nPEs) then
+      write(stderr,'(2a,2(a,i4))') myname_,	&
+	': _root_ argument error',		&
+	', size(lns) =',size(lns),		&
+	', nPEs =',nPEs
+      call die(myname_)
+    endif
+
+    GMap%counts(:)=lns(:)
+  endif
+
+  call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, root, comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier)
+
+  ! on each process, use GMap%counts(:) to compute GMap%displs(:)
+
+  l=0
+  do i=0,nPEs-1
+    GMap%displs(i)=l
+    l=l+GMap%counts(i)
+  end do
+
+  GMap%lsize=GMap%counts(myID)	! the local size
+  GMap%gsize=l	! the global size
+
+  ! finally, set and broadcast the component ID number GMap%comp_id
+
+  if(myID == root) GMap%comp_id = comp_id
+
+  call MPI_bcast(GMap%comp_id,1,MP_INTEGER,root,comm,ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier)
+
+ end subroutine initr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_remote_ Initialize Remote GlobalMap from the Root
+!
+! !DESCRIPTION:
+! This routine creates and propagates across the local communicator a 
+! {\tt GlobalMap} associated with a remote component.  The controlling 
+! process in this operation has MPI process ID defined by the input 
+! {\tt INTEGER} argument {\tt my\_root}, and its MPI communinicator 
+! is defined by the input {\tt INTEGER} argument {\tt my\_comm}.  The 
+! input {\tt INTEGER} argument {\tt remote\_npes} is the number of MPI 
+! processes on the remote component's communicator (which need be valid 
+! only on the process {\tt my\_root}).  The input the {\tt INTEGER} 
+! array {\tt remote\_lns(:)}, and the {\tt INTEGER} argument 
+! {\tt remote\_comp\_id} need only be valid on the process 
+! whose rank on the communicator {\tt my\_comm} is {\tt my\_root}.  The 
+! argument {\tt remote\_lns(:)} defines the vector segment length on each 
+! process of the remote component's communicator, and the argument 
+! {\tt remote\_comp\_id} defines the remote component's ID number in 
+! the MCT component registry {\tt MCTWorld}.
+!
+! !INTERFACE:
+
+ subroutine init_remote_(GMap, remote_lns, remote_npes, my_root, &
+                         my_comm, remote_comp_id)
+! !USES:
+
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, dimension(:), intent(in)  :: remote_lns
+      integer,               intent(in)  :: remote_npes
+      integer,               intent(in)  :: my_root
+      integer,               intent(in)  :: my_comm
+      integer,               intent(in)  :: remote_comp_id 
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalMap),       intent(out) :: GMap
+
+! !SEE ALSO:
+! The MCT module m_MCTWorld for more information regarding component 
+! ID numbers.
+!
+! !REVISION HISTORY:
+!  8Nov00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 26Jan01 - J.W. Larson <larson@mcs.anl.gov> - slight change--remote
+!           communicator is replaced by remote component ID number
+!           in argument remote_comp_id.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::init_remote_'
+  integer :: nPEs,myID,ier,l,i
+
+
+        ! Which processor am I on communicator my_comm?  Store
+        ! the answer in myID:
+
+  call MP_comm_rank(my_comm, myID, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+        ! allocate counts and displacements component arrays
+        ! for the sake of compactness, store the value of remote_npes
+        ! in the more tersely named variable nPEs.
+
+  if(myID == my_root) nPEs = remote_npes
+
+  call MPI_bcast(nPEs, 1, MP_INTEGER, my_root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(nPEs...)',ier)
+
+  allocate(GMap%counts(0:nPEs-1),GMap%displs(0:nPEs-1),stat=ier)
+  if(ier /= 0) call die(myname_,'allocate()',ier)
+
+#ifdef MALL_ON
+	call mall_ci(size(transfer(GMap%counts,(/1/))),myname_)
+	call mall_ci(size(transfer(GMap%displs,(/1/))),myname_)
+#endif
+
+        ! On the Root processor, check the size of remote_lns(:)
+        ! to see it is equal to nPEs, the number of remote processes,
+        ! then store it as GMap%counts and broadcast it.
+
+  if(myID == my_root) then
+    if(size(remote_lns(:)) /= nPEs) then
+      write(stderr,'(2a,2(a,i4))') myname_,	 &
+	': _root_ argument error',		 &
+	', size(remote_lns) =',size(remote_lns), &
+	', nPEs =',nPEs
+      call die(myname_)
+    endif
+
+    GMap%counts(:)=remote_lns(:)
+  endif
+
+  call MPI_bcast(GMap%counts, nPEs, MP_INTEGER, my_root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_bcast()',ier)
+
+        ! Now, on each processor of my_comm, compute from 
+        ! GMap%counts(:) the entries of GMap%displs(:)
+
+  l=0
+  do i=0,nPEs-1
+    GMap%displs(i)=l
+    l=l+GMap%counts(i)
+  end do
+
+  GMap%lsize = -1                ! In this case, the local size is invalid!!!
+  GMap%gsize = l      	         ! the global size
+
+        ! Finally, set GMap's component ID (recall only the value on
+        ! process my_root is valid).
+
+  if(myID == my_root)  GMap%comp_id = remote_comp_id
+  call MPI_bcast(GMap%comp_id, 1, MP_INTEGER, my_root, my_comm,ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_bcast(GMap%comp_id...)',ier)
+
+ end subroutine init_remote_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a GlobalMap
+!
+! !DESCRIPTION:
+! This routine deallocates all allocated memory associated with the 
+! input/output {\tt GlobalMap} argument {\tt GMap}, and sets to zero 
+! all of its statically defined components.  The success (failure) of 
+! this operation is signified by the zero (non-zero) value of the 
+! optional output {\tt INTEGER} argument {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine clean_(GMap, stat)
+
+! !USES:
+
+      use m_die
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(GlobalMap),           intent(inout) :: GMap
+
+! !OUTPUT PARAMETERS:
+
+      integer,         optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 26Jan01 - J. Larson <larson@mcs.anl.gov> incorporated comp_id.
+!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> removed the die to prevent
+!           crashes and added stat argument.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  deallocate(GMap%counts,GMap%displs,stat=ier)
+
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(GMap%...)',ier)
+  endif
+  
+  if(ier == 0) then
+
+#ifdef MALL_ON
+	call mall_co(size(transfer(GMap%counts,(/1/))),myname_)
+	call mall_co(size(transfer(GMap%displs,(/1/))),myname_)
+#endif
+
+  endif
+
+  GMap%lsize = 0
+  GMap%gsize = 0
+  GMap%comp_id = 0
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize_ - Return Local Segment Length
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} function returns the length of the local vector 
+! segment as defined by the input {\tt GlobalMap} argument {\tt GMap}.
+
+! !INTERFACE:
+
+ integer function lsize_(GMap)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in) :: GMap
+
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::lsize_'
+
+  lsize_=GMap%lsize
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: gsize_ - Return Global Vector Length
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} function returns the global length of a vector 
+! that is decomposed according to the input {\tt GlobalMap} argument 
+! {\tt GMap}.
+!
+! !INTERFACE:
+
+ integer function gsize_(GMap)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in) :: GMap
+
+
+! !REVISION HISTORY:
+! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::gsize_'
+
+  gsize_=GMap%gsize
+
+ end function gsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rank_ - Process ID Location of a Given Vector Element
+!
+! !DESCRIPTION:
+! This routine uses the input {\tt GlobalMap} argument {\tt GMap} to 
+! determine the process ID (on the communicator on which {\tt GMap} was
+! defined) of the vector element with global index {\tt i\_g}.  This 
+! process ID is returned in the output {\tt INTEGER} argument {\tt rank}.
+!
+! !INTERFACE:
+
+ subroutine rank_(GMap, i_g, rank)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in)  :: GMap
+      integer,         intent(in)  :: i_g
+
+! !OUTPUT PARAMETERS:
+
+      integer,         intent(out) :: rank
+
+! !REVISION HISTORY:
+!  5May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rank_'
+  integer :: i,ilc,ile
+
+  rank=-1	! if nowhere fits
+  do i=0,size(GMap%displs)-1
+    ilc=GMap%displs(i)
+    ile=ilc+GMap%counts(i)
+
+		! If i_g in (ilc,ile].  Note that i_g := [1:..]
+
+    if(ilc < i_g .and. i_g <= ile) then
+      rank=i
+      return
+    endif
+  end do
+
+ end subroutine rank_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bounds_ - First/Last Global Indicies for a Process' Segment
+!
+! !DESCRIPTION:
+! This routine takes as input a process ID (defined by the input 
+! {\tt INTEGER} argument {\tt pe\_no}), examines the input {\tt GlobalMap} 
+! argument {\tt GMap}, and returns the global indices for the first and 
+! last elements of the segment owned by this process in the output 
+! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd}, respectively.
+!
+! !INTERFACE:
+
+ subroutine bounds_(GMap, pe_no, lbnd, ubnd)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in)  :: GMap
+      integer,         intent(in)  :: pe_no
+
+! !OUTPUT PARAMETERS:
+
+      integer,         intent(out) :: lbnd
+      integer,         intent(out) :: ubnd
+
+! !REVISION HISTORY:
+! 30Jan01 - J. Larson <larson@mcs.anl.gov> - initial code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bounds_'
+
+  lbnd = GMap%displs(pe_no) + 1
+  ubnd = lbnd + GMap%counts(pe_no) - 1
+
+ end subroutine bounds_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: comp_id_ - Return the Component ID Number
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the MCT component ID number 
+! stored in the input {\tt GlobalMap} argument {\tt GMap}.
+!
+! !INTERFACE:
+
+ integer function comp_id_(GMap)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in) :: GMap
+
+! !SEE ALSO:
+! The MCT module m_MCTWorld for more information regarding component 
+! ID numbers.
+!
+! !REVISION HISTORY:
+! 25Jan02 - J. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::comp_id_'
+
+  comp_id_ = GMap%comp_id
+
+ end function comp_id_
+
+ end module m_GlobalMap
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMap.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMap.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMap.F90	(revision 4775)
@@ -0,0 +1,2434 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GlobalSegMap.F90,v 1.56 2009-03-17 16:51:49 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GlobalSegMap - a nontrivial 1-D decomposition of an array.
+!
+! !DESCRIPTION:
+! Consider the problem of the 1-dimensional decomposition of an array 
+! across multiple processes.  If each process owns only one contiguous 
+! segment, then the {\tt GlobalMap} (see {\tt m\_GlobalMap} or details) 
+! is sufficient to describe the decomposition.  If, however, each  
+! process owns multiple, non-adjacent segments of the array, a more 
+! sophisticated approach is needed.   The {\tt GlobalSegMap} data type 
+! allows one to describe a one-dimensional decomposition of an array
+! with each process owning multiple, non-adjacent segments of the array.
+!
+! In the current implementation of the {\tt GlobalSegMap}, there is no
+! santity check to guarantee that 
+!$${\tt GlobalSegMap\%gsize} = \sum_{{\tt i}=1}^{\tt ngseg} 
+! {\tt GlobalSegMap\%length(i)} . $$
+! The reason we have not implemented such a check is to allow the user
+! to use the {\tt GlobalSegMap} type to support decompositions of both 
+! {\em haloed} and {\em masked} data.
+!
+! !INTERFACE:
+
+ module m_GlobalSegMap
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: GlobalSegMap    ! The class data structure
+      public :: init            ! Create
+      public :: clean           ! Destroy
+      public :: comp_id         ! Return component ID number
+      public :: gsize           ! Return global vector size (excl. halos)
+      public :: GlobalStorage   ! Return total number of points in map,
+                                ! including halo points (if present).
+      public :: ProcessStorage  ! Return local storage on a given process.
+      public :: OrderedPoints   ! Return grid points of a given process in
+                                ! MCT-assumed order.
+      public :: lsize           ! Return local--that is, on-process--storage 
+                                ! size (incl. halos)
+      public :: ngseg           ! Return global number of segments
+      public :: nlseg           ! Return local number of segments
+      public :: max_nlseg       ! Return max local number of segments
+      public :: active_pes      ! Return number of pes with at least 1 
+                                ! datum, and if requested, a list of them.
+      public :: peLocs          ! Given an input list of point indices,
+                                ! return its (unique) process ID.
+      public :: haloed          ! Is the input GlobalSegMap haloed?
+      public :: rank            ! Rank which process owns a datum
+      public :: Sort            ! compute index permutation to re-order
+                                ! GlobalSegMap%start, GlobalSegMap%length,
+                                ! and GlobalSegMap%pe_loc
+      public :: Permute         ! apply index permutation to re-order 
+                                ! GlobalSegMap%start, GlobalSegMap%length,
+                                ! and GlobalSegMap%pe_loc
+      public :: SortPermute     ! compute index permutation and apply it to
+                                ! re-order the GlobalSegMap components
+                                ! GlobalSegMap%start, GlobalSegMap%length,
+                                ! and GlobalSegMap%pe_loc
+      public :: increasing      ! Are the indices for each pe strictly
+                                ! increasing?
+      public :: copy            ! Copy the gsmap
+
+! !PUBLIC TYPES:
+
+    type GlobalSegMap
+#ifdef SEQUENCE
+      sequence
+#endif
+      integer :: comp_id			! Component ID number
+      integer :: ngseg				! No. of Global segments
+      integer :: gsize				! No. of Global elements
+      integer,dimension(:),pointer :: start	! global seg. start index
+      integer,dimension(:),pointer :: length	! segment lengths
+      integer,dimension(:),pointer :: pe_loc	! PE locations
+    end type GlobalSegMap
+
+    interface init ; module procedure	&
+        initd_,	&       ! initialize from all PEs
+        initr_, &       ! initialize from the root
+        initp_,	&       ! initialize in parallel from replicated arrays
+        initp1_, &      ! initialize in parallel from 1 replicated array
+        initp0_, &      ! null constructor using replicated data
+        init_index_     ! initialize from local index arrays
+    end interface
+
+    interface clean   ; module procedure clean_   ; end interface
+    interface comp_id ; module procedure comp_id_ ; end interface
+    interface gsize   ; module procedure gsize_   ; end interface
+    interface GlobalStorage ; module procedure &
+       GlobalStorage_
+    end interface
+    interface ProcessStorage ; module procedure &
+       ProcessStorage_
+    end interface
+    interface OrderedPoints ; module procedure &
+       OrderedPoints_
+    end interface
+    interface lsize ; module procedure lsize_ ; end interface
+    interface ngseg ; module procedure ngseg_ ; end interface
+    interface nlseg ; module procedure nlseg_ ; end interface
+    interface max_nlseg ; module procedure max_nlseg_ ; end interface
+    interface active_pes ; module procedure active_pes_ ; end interface
+    interface peLocs ; module procedure peLocs_ ; end interface
+    interface haloed ; module procedure haloed_ ; end interface
+    interface rank  ; module procedure &
+	rank1_ , &      ! single rank case
+	rankm_	        ! degenerate (multiple) ranks for halo case
+    end interface
+    interface Sort ; module procedure Sort_ ; end interface
+    interface Permute ; module procedure &
+	PermuteInPlace_ 
+    end interface
+    interface SortPermute ; module procedure &
+	SortPermuteInPlace_ 
+    end interface
+    interface increasing ; module procedure increasing_ ; end interface
+    interface copy ; module procedure copy_ ; end interface
+
+
+! !REVISION HISTORY:
+! 	28Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	26Jan01 - J.W. Larson <larson@mcs.anl.gov> - replaced the component
+!                 GlobalSegMap%comm with GlobalSegMap%comp_id.
+! 	06Feb01 - J.W. Larson <larson@mcs.anl.gov> - removed the 
+!                 GlobalSegMap%lsize component.  Also, added the 
+!                 GlobalStorage query function.
+! 	24Feb01 - J.W. Larson <larson@mcs.anl.gov> - Added the replicated
+!                 initialization routines initp_() and initp1(). 
+! 	25Feb01 - J.W. Larson <larson@mcs.anl.gov> - Added the routine
+!                 ProcessStorage_().
+! 	18Apr01 - J.W. Larson <larson@mcs.anl.gov> - Added the routine
+!                 peLocs().
+! 	26Apr01 - R. Jacob <jacob@mcs.anl.gov> - Added the routine
+!                 OrderedPoints_().
+!       03Aug01 - E. Ong <eong@mcs.anl.gov> - In initd_, call initr_
+!                 with actual shaped arguments on non-root processes to satisfy
+!                 F90 standard. See comments in initd.          
+! 	18Oct01 - J.W. Larson <larson@mcs.anl.gov> - Added the routine 
+!                 bcast(), and also cleaned up prologues.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='m_GlobalSegMap'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initd_ - define the map from distributed data
+!
+! !DESCRIPTION:
+! This routine takes the {\em scattered} input {\tt INTEGER} arrays 
+! {\tt start}, {\tt length}, and {\tt pe\_loc}, gathers these data to
+! the {\tt root} process, and from them creates a {\em global} set of
+! segment information for the output {\tt GlobalSegMap} argument 
+! {\tt GSMap}.  The input {\tt INTEGER} arguments {\tt comp\_id}, 
+! {\tt gsize} provide the {\tt GlobalSegMap} component ID number and 
+! global grid size, respectively.  The input argument {\tt my\_comm} is 
+! the F90 {\tt INTEGER} handle for the MPI communicator.  If the input
+! arrays are overdimensioned, optional argument {\em numel} can be
+! used to specify how many elements should be used.
+! 
+!
+! !INTERFACE:
+
+ subroutine initd_(GSMap, start, length, root, my_comm, &
+                   comp_id, pe_loc, gsize, numel)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+      use m_FcComms, only : fc_gather_int, fc_gatherv_int
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,dimension(:),intent(in) :: start          ! segment local start 
+                                                        ! indices
+      integer,dimension(:),intent(in) :: length         ! segment local lengths
+      integer,intent(in)              :: root           ! root on my_com
+      integer,intent(in)              :: my_comm        ! local communicatior
+      integer,intent(in)              :: comp_id        ! component model ID
+      integer,dimension(:), pointer, optional :: pe_loc ! process location
+      integer,intent(in), optional    :: gsize          ! global vector size
+                                                        ! (optional).  It can
+                                                        ! be computed by this 
+                                                        ! routine if no haloing
+                                                        ! is assumed.
+      integer,intent(in), optional    :: numel          ! specify number of elements
+							! to use in start, length
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(out)  :: GSMap   ! Output GlobalSegMap
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	14Nov00 - J.W. Larson <larson@mcs.anl.gov> - final working version
+! 	09Jan01 - J.W. Larson <larson@mcs.anl.gov> - repaired:  a subtle 
+!                 bug concerning the usage of the argument pe_loc (result 
+!                 was the new pointer variable my_pe_loc); a mistake in 
+!                 the tag arguments to MPI_IRECV; a bug in the declaration
+!                 of the array status used by MPI_WAITALL.
+! 	26Jan01 - J.W. Larson <larson@mcs.anl.gov> - replaced optional 
+!                 argument gsm_comm with required argument comp_id.
+!       23Sep02 - Add optional argument numel to allow start, length
+!                 arrays to be overdimensioned.
+!       31Jan09 - P.H. Worley <worleyph@ornl.gov> - replaced irecv/send/waitall 
+!                 logic with calls to flow controlled gather routines
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initd_'
+  integer :: nPEs, myID, ier, l, i
+  integer :: ngseg  ! number of global segments
+  integer :: nlseg  ! number of local segments
+  integer :: nlseg_tmp(1) ! workaround for explicit interface expecting an array
+
+        ! arrays allocated on the root to which data are gathered
+  integer, dimension(:), allocatable :: root_start, root_length, root_pe_loc
+        ! arrays allocated on the root to coordinate gathering of 
+        ! data and non-blocking receives by the root
+  integer, dimension(:), allocatable :: counts, displs
+        ! data and non-blocking receives by the root
+  integer, dimension(:), pointer :: my_pe_loc
+
+        ! Determine local process ID:
+
+  call MP_COMM_RANK(my_comm, myID, ier)
+
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+
+        ! Check consistency of sizes of input arrays:
+
+  if(size(length) /= size(start)) then
+     ier = -1
+     call die(myname_,'length/start array size mismatch',ier)
+  endif
+
+  if(present(pe_loc)) then
+     if(size(pe_loc) /= size(start)) then
+	ier = -1
+	call die(myname_,'pe_loc/start array size mismatch',ier)
+     endif
+  endif
+
+        ! Store in the variable nlseg the local size 
+        ! array start(:)
+
+  if(present(numel)) then
+    nlseg=numel
+  else
+    nlseg = size(start)
+  endif
+
+        ! If the argument pe_loc is not present, then we are
+        ! initializing the GlobalSegMap on the communicator 
+        ! my_comm.  We will need pe_loc to be allocated and
+        ! with local size given by the input value of nlseg,
+        ! and then initialize it with the local process id myID.
+
+  if(present(pe_loc)) then
+     my_pe_loc => pe_loc
+  else
+     allocate(my_pe_loc(nlseg), stat=ier)
+     if(ier /= 0) call die(myname_,'allocate(my_pe_loc)',ier)
+     my_pe_loc = myID
+  endif
+
+  call MPI_COMM_SIZE(my_comm, npes, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MPI_COMM_SIZE()',ier)
+
+        ! Allocate an array of displacements (displs) and counts
+        ! to hold the local values of nlseg on the root
+
+  if(myID == root) then
+     allocate(counts(0:npes-1), displs(0:npes-1), stat=ier)
+     if (ier /= 0) then  
+	call die(myname_, 'allocate(counts,...',ier)
+     endif
+  else
+     allocate(counts(1), displs(1), stat=ier)
+     if (ier /= 0) then  
+	call die(myname_, 'allocate(counts,...',ier)
+     endif
+  endif
+
+        ! Send local number of segments to the root.
+
+  nlseg_tmp(1) = nlseg
+  call fc_gather_int(nlseg_tmp, 1, MP_INTEGER, counts, 1, MP_INTEGER, &
+                     root, my_comm)
+
+        ! On the root compute the value of ngseg, along with
+        ! the entries of counts and displs.
+
+  if(myID == root) then
+     ngseg = 0
+     do i=0,npes-1
+	ngseg = ngseg + counts(i)
+        if(i == 0) then
+	   displs(i) = 0
+	else
+	   displs(i) = displs(i-1) + counts(i-1)
+	endif
+     end do
+  endif
+
+        ! Now only the root has the correct value of ngseg.
+
+        ! On the root, allocate memory for the arrays root_start,
+        ! and root_length.  If the argument pe_loc is present,
+        ! allocate root_pe_loc, too.
+
+        ! Non-root processes call initr_ with root_start, root_length, 
+        ! and root_pe_loc, although these arguments are not used in the 
+        ! subroutine. Since these correspond to dummy shaped array arguments
+        ! in initr_, the Fortran 90 standard dictates that the actual 
+        ! arguments must contain complete shape information. Therefore, 
+        ! these array arguments must be allocated on all processes.
+  
+  if(myID == root) then
+
+     allocate(root_start(ngseg), root_length(ngseg), &
+	      root_pe_loc(ngseg), stat=ier)
+     if (ier /= 0) then
+	call die(myname_, 'allocate(root_start...',ier)
+     endif
+
+  else
+
+     allocate(root_start(1), root_length(1), &
+	      root_pe_loc(1), stat=ier)
+     if (ier /= 0) then
+	call die(myname_, 'allocate((non)root_start...',ier)
+     endif
+
+  endif
+
+        ! Now, each process sends its values of start(:) to fill in 
+        ! the appropriate portion of root_start(:y) on the root.
+
+  call fc_gatherv_int(start, nlseg, MP_INTEGER, &
+                      root_start, counts, displs, MP_INTEGER, &
+                      root, my_comm)
+
+        ! Next, each process sends its values of length(:) to fill in 
+        ! the appropriate portion of root_length(:) on the root.
+
+  call fc_gatherv_int(length, nlseg, MP_INTEGER, &
+                      root_length, counts, displs, MP_INTEGER, &
+                      root, my_comm)
+
+        ! Finally, if the argument pe_loc is present, each process sends 
+        ! its values of pe_loc(:) to fill in the appropriate portion of 
+        ! root_pe_loc(:) on the root.  
+   
+  call fc_gatherv_int(my_pe_loc, nlseg, MP_INTEGER, &
+                      root_pe_loc, counts, displs, MP_INTEGER, &
+                      root, my_comm)
+
+  call MPI_BARRIER(my_comm, ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MPI_BARRIER my_pe_loc',ier)
+
+        ! Now, we have everything on the root needed to call initr_().
+
+  if(present(gsize)) then
+     call initr_(GSMap, ngseg, root_start, root_length, &
+                 root_pe_loc, root, my_comm, comp_id, gsize)
+  else
+     call initr_(GSMap, ngseg, root_start, root_length, &
+                 root_pe_loc, root, my_comm, comp_id)
+  endif
+
+
+        ! Clean up the array pe_loc(:) if it was allocated
+
+  if(present(pe_loc)) then
+     nullify(my_pe_loc) 
+  else
+     deallocate(my_pe_loc, stat=ier)
+     if(ier /= 0) call die(myname_, 'deallocate(my_pe_loc)', ier)
+  endif
+
+        ! Clean up the arrays root_start(:), et cetera...
+
+  deallocate(root_start, root_length, root_pe_loc, stat=ier)
+  if(ier /= 0) then
+     call die(myname_, 'deallocate(root_start,...)', ier)
+  endif
+
+        ! Clean up the arrays counts(:) and displs(:)
+
+   deallocate(counts, displs, stat=ier)
+   if(ier /= 0) then
+     call die(myname_, 'deallocate(counts,...)', ier)
+   endif
+
+ end subroutine initd_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initr_ initialize the map from the root
+!
+! !DESCRIPTION:
+! This routine takes the input {\tt INTEGER} arrays {\tt start}, 
+! {\tt length}, and {\tt pe\_loc} (all valid only on the {\tt root} 
+! process), and from them creates a {\em global} set of segment 
+! information for the output {\tt GlobalSegMap} argument 
+! {\tt GSMap}.  The input {\tt INTEGER} arguments {\tt ngseg}, 
+! {\tt comp\_id}, {\tt gsize} (again, valid only on the {\tt root} 
+! process) provide the {\tt GlobalSegMap} global segment count, component 
+! ID number, and global grid size, respectively.  The input argument 
+! {\tt my\_comm} is the F90 {\tt INTEGER} handle for the MPI communicator.
+!
+! !INTERFACE:
+
+ subroutine initr_(GSMap, ngseg, start, length, pe_loc, root,  &
+                   my_comm, comp_id, gsize)
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+ 
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, intent(in)             :: ngseg   ! no. of global segments
+      integer,dimension(:),intent(in) :: start   ! segment local start index 
+      integer,dimension(:),intent(in) :: length  ! the distributed sizes
+      integer,dimension(:),intent(in) :: pe_loc  ! process location
+      integer,intent(in)              :: root    ! root on my_com
+      integer,intent(in)              :: my_comm ! local communicatior
+      integer,intent(in)              :: comp_id ! component id number
+      integer,intent(in), optional    :: gsize   ! global vector size
+                                                 ! (optional).  It can
+                                                 ! be computed by this 
+                                                 ! routine if no haloing
+                                                 ! is assumed.
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(out)  :: GSMap   ! Output GlobalSegMap
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	09Nov00 - J.W. Larson <larson@mcs.anl.gov> - final working version
+! 	10Jan01 - J.W. Larson <larson@mcs.anl.gov> - minor bug fix
+! 	12Jan01 - J.W. Larson <larson@mcs.anl.gov> - minor bug fix regarding
+!                                                    disparities in ngseg on
+!                                                    the root and other 
+!                                                    processes
+! 	26Jan01 - J.W. Larson <larson@mcs.anl.gov> - replaced optional 
+!                 argument gsm_comm with required argument comp_id.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initr_'
+  integer :: myID,ier,l,i
+
+        ! Determine the local process ID myID:
+
+  call MPI_COMM_RANK(my_comm, myID, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_COMM_RANK()',ier)
+
+        ! Argument checking:  check to make sure the arrays
+        ! start, length, and pe_loc each have ngseg elements.
+        ! If not, stop with an error.  This is done on the 
+        ! root process since it owns the initialization data.
+
+  if(myID == root) then
+    if( size(start(:)) /= ngseg ) then
+      write(stderr,'(2a,2(a,i4))') myname_,	&
+	': _root_ argument error',		&
+	', size(start) =',size(start),	&
+	', ngseg =',ngseg
+      call die(myname_)
+    endif
+    if( size(length(:)) /= ngseg ) then
+      write(stderr,'(2a,2(a,i4))') myname_,	&
+	': _root_ argument error',		&
+	', size(length) =',size(length),	&
+	', ngseg =',ngseg
+      call die(myname_)
+    endif
+    if( size(pe_loc(:)) /= ngseg ) then
+      write(stderr,'(2a,2(a,i4))') myname_,	&
+	': _root_ argument error',		&
+	', size(pe_loc) =',size(pe_loc),	&
+	', ngseg =',ngseg
+      call die(myname_)
+    endif
+  endif
+
+        ! Initialize GSMap%ngseg and GSMap%comp_id on the root:
+
+  if(myID == root) then
+     GSMap%ngseg = ngseg
+     GSMap%comp_id = comp_id
+  endif
+
+        ! Broadcast the value of GSMap%ngseg
+
+  call MPI_BCAST(GSMap%ngseg, 1, MP_INTEGER, root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCAST(GSmap%ngseg)',ier)
+
+        ! Broadcast the value of GSMap%comp_id
+
+  call MPI_BCAST(GSMap%comp_id, 1, MP_INTEGER, root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCAST(GSmap%comp_id)',ier)
+
+        ! Allocate the components GSMap%start(:), GSMap%length(:),
+        ! and GSMap%pe_loc(:)
+
+  allocate(GSMap%start(GSMap%ngseg), GSMap%length(GSMap%ngseg), &
+           GSMap%pe_loc(GSMap%ngseg), stat = ier)
+  if(ier/=0) call die(myname_,'allocate(GSmap%start(:),...',ier)
+
+#ifdef MALL_ON
+	call mall_ci(size(transfer(GSMap%start,(/1/))),myname_)
+	call mall_ci(size(transfer(GSMap%length,(/1/))),myname_)
+	call mall_ci(size(transfer(GSMap%pe_loc,(/1/))),myname_)
+#endif
+
+        ! On the root process, initialize GSMap%start(:), GSMap%length(:),
+        ! and GSMap%pe_loc(:) with the data contained in start(:), 
+        ! length(:) and pe_loc(:), respectively
+
+  if(myID == root) then
+     GSMap%start(1:GSMap%ngseg) = start(1:GSMap%ngseg)
+     GSMap%length(1:GSMap%ngseg) = length(1:GSMap%ngseg)
+     GSMap%pe_loc(1:GSMap%ngseg) = pe_loc(1:GSMap%ngseg)
+  endif
+
+        ! Broadcast the root values of GSMap%start(:), GSMap%length(:),
+        ! and GSMap%pe_loc(:)
+
+  call MPI_BCAST(GSMap%start, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCAST(GSMap%start)',ier)
+
+  call MPI_BCAST(GSMap%length, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCAST(GSMap%length)',ier)
+
+  call MPI_BCAST(GSMap%pe_loc, GSMap%ngseg, MP_INTEGER, root, my_comm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCAST(GSMap%pe_loc)',ier)
+
+        ! If the argument gsize is present, use the root value to
+        ! set GSMap%gsize and broadcast it.  If it is not present,
+        ! this will be computed by summing the entries of GSM%length(:).
+        ! Again, note that if one is storing halo points, the sum will
+        ! produce a result larger than the actual global vector.  If
+        ! halo points are to be used in the mapping we advise strongly
+        ! that the user specify the value gsize as an argument.
+
+  if(present(gsize)) then
+     if(myID == root) then
+	GSMap%gsize = gsize
+     endif
+     call MPI_BCAST(GSMap%gsize, 1, MP_INTEGER, root, my_comm, ier)
+     if(ier/=0) call MP_perr_die(myname_, 'MPI_BCAST(GSMap%gsize)', ier)
+  else
+     GSMap%gsize = 0
+     do i=1,GSMap%ngseg
+	GSMap%gsize = GSMap%gsize + GSMap%length(i)
+     end do
+  endif
+
+ end subroutine initr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initp_ - define the map from replicated data.
+!
+! !DESCRIPTION:
+!
+! The routine {\tt initp\_()} takes the input {\em replicated} arguments
+! {\tt comp\_id}, {\tt ngseg}, {\tt gsize}, {\tt start(:)}, 
+! {\tt length(:)}, and {\tt pe\_loc(:)}, and uses them to initialize an
+! output {\tt GlobalSegMap} {\tt GSMap}.  This routine operates on the 
+! assumption that these data are replicated across the communicator on
+! which the {\tt GlobalSegMap} is being created.
+!
+! !INTERFACE:
+
+ subroutine initp_(GSMap, comp_id, ngseg, gsize, start, length, pe_loc)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,intent(in)              :: comp_id ! component model ID
+      integer,intent(in)              :: ngseg   ! global number of segments
+      integer,intent(in)              :: gsize   ! global vector size
+      integer,dimension(:),intent(in) :: start   ! segment local start index 
+      integer,dimension(:),intent(in) :: length  ! the distributed sizes
+      integer,dimension(:),intent(in) :: pe_loc  ! process location
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(out)  :: GSMap   ! Output GlobalSegMap
+
+! !REVISION HISTORY:
+! 	24Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initp_'
+  integer :: ierr, n
+
+       ! Argument Checks -- Is comp_id positive?
+
+  if(comp_id <= 0) then
+     call die(myname_,'non-positive value of comp_id',comp_id)
+  endif
+
+       ! Is gsize positive?
+
+  if(gsize <= 0) then
+     call die(myname_,'non-positive value of gsize',gsize)
+  endif
+
+
+       ! Is ngseg positive?
+
+  if(ngseg <= 0) then
+     call die(myname_,'non-positive value of ngseg',ngseg)
+  endif
+
+       ! Are the arrays start(:), length(:), and pe_loc(:) the 
+       !correct size?
+
+  if(size(start) /= ngseg) then
+     call die(myname_,'start(:)/ngseg size mismatch',ngseg)
+  endif
+  if (size(length) /= ngseg) then
+     call die(myname_,'length(:)/ngseg size mismatch',ngseg)
+  endif
+  if (size(pe_loc) /= ngseg) then
+     call die(myname_,'pe_loc(:)/ngseg size mismatch',ngseg)
+  endif
+
+       ! Allocate index and location arrays for GSMap:
+
+  allocate(GSMap%start(ngseg), GSMap%length(ngseg), GSMap%pe_loc(ngseg), &
+           stat = ierr)
+  if (ierr /= 0) then
+     call die(myname_,'allocate(GSMap%start...',ngseg)
+  endif
+       
+       ! Assign the components of GSMap:
+
+  GSMap%comp_id = comp_id
+  GSMap%ngseg = ngseg
+  GSMap%gsize = gsize
+
+  do n=1,ngseg
+     GSMap%start(n) = start(n)
+     GSMap%length(n) = length(n)
+     GSMap%pe_loc(n) = pe_loc(n)
+  end do
+
+  end subroutine initp_     
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initp1_ - define the map from replicated data using 1 array.
+!
+! !DESCRIPTION:
+!
+! The routine {\tt initp1\_()} takes the input {\em replicated} arguments
+! {\tt comp\_id}, {\tt ngseg}, {\tt gsize}, and {\tt all\_arrays(:)}, 
+! and uses them to initialize an output {\tt GlobalSegMap} {\tt GSMap}.  
+! This routine operates on the assumption that these data are replicated 
+! across the communicator on which the {\tt GlobalSegMap} is being created.
+! The input array {\tt all\_arrays(:)} should be of length {\tt 2 * ngseg},
+! and is packed so that
+! $$ {\tt all\_arrays(1:ngseg)} = {\tt GSMap\%start(1:ngseg)} $$
+! $$ {\tt all\_arrays(ngseg+1:2*ngseg)} = {\tt GSMap\%length(1:ngseg)} $$
+! $$ {\tt all\_arrays(2*ngseg+1:3*ngseg)} = {\tt GSMap\%pe\_loc(1:ngseg)} .$$
+!
+! !INTERFACE:
+
+ subroutine initp1_(GSMap, comp_id, ngseg, gsize, all_arrays)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,intent(in)              :: comp_id    ! component model ID
+      integer,intent(in)              :: ngseg      ! global no. of segments
+      integer,intent(in)              :: gsize      ! global vector size
+      integer,dimension(:),intent(in) :: all_arrays ! packed array of length
+                                                    ! 3*ngseg containing (in
+                                                    ! this order):  start(:),
+                                                    ! length(:), and pe_loc(:)
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(out)  :: GSMap      ! Output GlobalSegMap
+
+! !REVISION HISTORY:
+! 	24Feb01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initp1_'
+  integer :: ierr, n
+
+       ! Argument Checks -- Is comp_id positive?
+
+  if(comp_id <= 0) then
+     call die(myname_,'non-positive value of comp_id',comp_id)
+  endif
+
+       ! Is gsize positive?
+
+  if(gsize <= 0) then
+     call die(myname_,'non-positive value of gsize',gsize)
+  endif
+
+
+       ! Is ngseg positive?
+
+  if(ngseg <= 0) then
+     call die(myname_,'non-positive value of ngseg',ngseg)
+  endif
+
+       ! Is the array all_arrays(:) the right length?
+
+  if(size(all_arrays) /= 3*ngseg) then
+     call die(myname_,'all_arrays(:)/3*ngseg size mismatch',ngseg)
+  endif
+
+       ! Allocate index and location arrays for GSMap:
+
+  allocate(GSMap%start(ngseg), GSMap%length(ngseg), GSMap%pe_loc(ngseg), &
+           stat = ierr)
+  if (ierr /= 0) then
+     call die(myname_,'allocate(GSMap%start...',ngseg)
+  endif
+       
+       ! Assign the components of GSMap:
+
+  GSMap%comp_id = comp_id
+  GSMap%ngseg = ngseg
+  GSMap%gsize = gsize
+
+  do n=1,ngseg
+     GSMap%start(n) = all_arrays(n)
+     GSMap%length(n) = all_arrays(ngseg + n)
+     GSMap%pe_loc(n) = all_arrays(2*ngseg + n)
+  end do
+
+  end subroutine initp1_     
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initp0_ - Null Constructor Using Replicated Data
+!
+! !DESCRIPTION:
+!
+! The routine {\tt initp0\_()} takes the input {\em replicated} arguments
+! {\tt comp\_id}, {\tt ngseg}, {\tt gsize}, and uses them perform null 
+! construction of the output {\tt GlobalSegMap} {\tt GSMap}.  This is a 
+! null constructor in the sense that we are not filling in the segment 
+! information arrays.  This routine operates on the assumption that these 
+! data are replicated across the communicator on which the 
+! {\tt GlobalSegMap} is being created.
+!
+! !INTERFACE:
+
+ subroutine initp0_(GSMap, comp_id, ngseg, gsize)
+
+!
+! !USES:
+!
+      use m_die, only : die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,intent(in)              :: comp_id ! component model ID
+      integer,intent(in)              :: ngseg   ! global number of segments
+      integer,intent(in)              :: gsize   ! global vector size
+
+! !OUTPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(out)  :: GSMap   ! Output GlobalSegMap
+
+! !REVISION HISTORY:
+! 13Aug03 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initp0_'
+
+  integer :: ierr
+
+  nullify(GSMap%start)
+  nullify(GSMap%length)
+  nullify(GSMap%pe_loc)
+
+  GSMap%comp_id = comp_id
+  GSMap%ngseg = ngseg
+  GSMap%gsize = gsize
+
+  allocate(GSMap%start(ngseg), GSMap%length(ngseg), GSMap%pe_loc(ngseg), &
+           stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_, &
+	  ':: FATAL--allocate of segment information storage space failed.', &
+	  '  ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine initp0_
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_index_ - initialize GSM from local index arrays
+!
+! !DESCRIPTION:
+!
+! The routine {\tt init\_index\_()} takes a local array of indices 
+! {\tt lindx} and uses them to create a {\tt GlobalSegMap}.  
+! {\tt lindx} is parsed to determine the lengths of the runs, and 
+! then a call is made to {\tt initd\_}.  The optional argument 
+! {\tt lsize} can be used if only the first {\tt lsize} number 
+! of elements of {\tt lindx} are valid.  The optional argument
+! {\tt gsize} is used to specify the global number of unique points
+! if this can not be determined from the collective {\tt lindx}.
+!
+!
+! !INTERFACE:
+
+    subroutine init_index_(GSMap, lindx, my_comm, comp_id, lsize, gsize)
+
+!
+! !USES:
+!
+
+!  use m_GlobalSegMap,only: GlobalSegMap
+!  use m_GlobalSegMap,only: MCT_GSMap_init => init
+
+!  use shr_sys_mod
+
+  use m_die
+  implicit none
+
+! !INPUT PARAMETERS: 
+
+     integer , dimension(:),intent(in) :: lindx   ! index buffer
+     integer , intent(in) :: my_comm         ! mpi communicator group (mine)
+     integer , intent(in) :: comp_id         ! component id (mine)
+
+     integer , intent(in),optional :: lsize  ! size of index buffer
+     integer , intent(in),optional :: gsize  ! global vector size
+
+! !OUTPUT PARAMETERS:
+
+     type(GlobalSegMap),intent(out) :: GSMap ! Output GlobalSegMap
+     
+
+! !REVISION HISTORY:
+!       30Jul02 - T. Craig - initial version in cpl6.
+!       17Nov05 - R. Loy <rloy@mcs.anl.gov> - install into MCT
+!       18Nov05 - R. Loy <rloy@mcs.anl.gov> - make lsize optional
+!       25Jul06 - R. Loy <rloy@mcs.anl.gov> - error check on lindex/alloc/dealloc
+!EOP ___________________________________________________________________
+
+
+     !--- local ---
+
+     character(len=*),parameter :: myname_=myname//'::init_index_'
+
+     integer             :: i,j,k,n      ! generic indicies
+     integer             :: nseg         ! counts number of segments for GSMap
+     integer,allocatable :: start(:)     ! used to init GSMap 
+     integer,allocatable :: count(:)     ! used to init GSMap 
+     integer,parameter   :: pid0=0       ! mpi process id for root pe
+     integer,parameter   :: debug=0      ! 
+
+     integer rank,ierr
+     integer mysize
+
+
+     if (present(lsize)) then
+       mysize=lsize
+     else
+       mysize=size(lindx)
+     endif
+
+     if (mysize<0) call die(myname_, &
+        'lindx size is negative (you may have run out of points)')
+
+!!
+!! Special case if this processor doesn't have any data indices
+!! 
+   if (mysize==0) then
+     allocate(start(0),count(0),stat=ierr)
+     if(ierr/=0) call die(myname_,'allocate(start,count)',ierr)
+    
+     nseg=0
+   else
+
+     call MPI_COMM_RANK(my_comm,rank, ierr)
+
+     ! compute segment's start indicies and length counts 
+
+     ! first pass - count how many runs of consecutive numbers
+
+     nseg=1
+     do n = 2,mysize
+        i = lindx(n-1)
+        j = lindx(n)
+        if ( j-i /= 1) nseg=nseg+1
+     end do
+
+     allocate(start(nseg),count(nseg),stat=ierr)
+     if(ierr/=0) call die(myname_,'allocate(start,count)',ierr)
+
+     ! second pass - determine how long each run is
+
+     nseg = 1
+     start(nseg) = lindx(1)
+     count(nseg) = 1
+     do n = 2,mysize
+        i = lindx(n-1)
+        j = lindx(n)
+        if ( j-i /= 1) then
+            nseg = nseg+1
+            start(nseg) = lindx(n)
+            count(nseg) = 1
+         else
+            count(nseg) = count(nseg)+1
+         end if
+     end do
+
+   endif ! if mysize==0
+
+
+     if (debug.ne.0) then
+	write(6,*) rank,'init_index: SIZE ',nseg
+
+	do n=1,nseg
+          write(6,*) rank,'init_index: START,COUNT ',start(n),count(n)
+	end do
+     endif
+
+
+      if (present(gsize)) then
+        call initd_( GSMap, start, count, pid0, my_comm,  &
+                     comp_id, gsize=gsize)
+      else
+        call initd_( GSMap, start, count, pid0, my_comm,  &
+  	             comp_id)
+      endif
+
+
+      deallocate(start, count, stat=ierr)
+      if(ierr/=0) call warn(myname_,'deallocate(start,count)',ierr)
+      
+
+   end subroutine init_index_
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - clean the map
+!
+! !DESCRIPTION:
+! This routine deallocates the array components of the {\tt GlobalSegMap}
+! argument {\tt GSMap}: {\tt GSMap\%start}, {\tt GSMap\%length}, and
+! {\tt GSMap\%pe\_loc}.  It also zeroes out the values of the integer
+! components {\tt GSMap\%ngseg}, {\tt GSMap\%comp\_id}, and
+! {\tt GSMap\%gsize}.
+!
+! !INTERFACE:
+
+    subroutine clean_(GSMap,stat)
+!
+! !USES:
+!
+      use m_die
+
+      implicit none
+ 
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(inout) :: GSMap
+      integer, optional,  intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!       01Mar02 - E.T. Ong <eong@mcs.anl.gov> - added stat argument. 
+!                 Removed dies to prevent crashing.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+#ifdef MALL_ON
+  
+  if( (associated(GSMap%start) .and. associated(GSMap%length)) &
+       .and. associated(GSMap%pe_loc) )
+     call mall_co(size(transfer(GSMap%start,(/1/))),myname_)
+     call mall_co(size(transfer(GSMap%length,(/1/))),myname_)
+     call mall_co(size(transfer(GSMap%pe_loc,(/1/))),myname_)
+  endif
+
+#endif
+
+  deallocate(GSMap%start, GSMap%length, GSMap%pe_loc, stat=ier)
+
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(GSMap%start,...)',ier)
+  endif
+
+  GSMap%ngseg = 0
+  GSMap%comp_id  = 0
+  GSMap%gsize = 0
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ngseg_ - Return the global number of segments from the map
+!
+! !DESCRIPTION:
+! The function {\tt ngseg\_()} returns the global number of vector
+! segments in the {\tt GlobalSegMap} argument {\tt GSMap}.  This is
+! merely the value of {\tt GSMap\%ngseg}.
+!
+! !INTERFACE:
+
+ integer function ngseg_(GSMap)
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: GSMap
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ngseg_'
+
+  ngseg_=GSMap%ngseg
+
+ end function ngseg_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nlseg_ - Return the local number of segments from the map
+!
+! !DESCRIPTION:
+! The function {\tt nlseg\_()} returns the number of vector segments 
+! in the {\tt GlobalSegMap} argument {\tt GSMap} that reside on the 
+! process specified by the input argument {\tt pID}.  This is the 
+! number of entries {\tt GSMap\%pe\_loc} whose value equals {\tt pID}.
+!
+! !INTERFACE:
+
+ integer function nlseg_(GSMap, pID)
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: GSMap
+      integer,           intent(in) :: pID
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	14Jun01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix in lower
+!                 limit of loop over elements of GSMap%pe_loc(:).  The
+!                 original code had this lower limit set to 0, which
+!                 was out-of-bounds (but uncaught).  The correct lower
+!                 index is 1.  This bug was discovered by Everest Ong.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nlseg_'
+  integer :: i, nlocseg
+
+        ! Initialize the number of segments residing on pID, nlocseg
+
+  nlocseg = 0
+
+        ! Compute the number of segments residing on pID, nlocseg
+
+  do i=1,GSMap%ngseg
+     if(GSMap%pe_loc(i) == pID) then
+	nlocseg = nlocseg + 1
+     endif
+  end do
+
+        ! Return the total
+
+  nlseg_ = nlocseg
+
+ end function nlseg_
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: max_nlseg_ - Return the max number of segments over all procs
+!
+! !DESCRIPTION:
+! The function {\tt max\_nlseg\_()} returns the maximum number 
+! over all processors of the vector
+! segments in the {\tt GlobalSegMap} argument {\tt gsap} 
+! E.g. max\_p(nlseg(gsmap,p)) but computed more efficiently
+!
+! !INTERFACE:
+
+        integer function max_nlseg_(gsmap)
+
+! !USES:
+
+        use m_MCTWorld,      only :ThisMCTWorld
+        use m_mpif90
+        use m_die
+
+        use m_stdio    ! rml
+
+        implicit none
+
+! !INPUT PARAMETERS: 
+
+        type(GlobalSegMap), intent(in) :: gsmap
+
+
+! !REVISION HISTORY:
+! 	17Jan07 - R. Loy <rloy@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+
+
+! Local variables
+
+        character(len=*),parameter :: myname_=myname//'::max_local_segs'
+
+        integer i
+        integer this_comp_id
+        integer nprocs
+
+        integer, allocatable::  segcount(:)  ! segments on proc i
+        integer ier
+
+        integer this_ngseg
+        integer segment_pe
+        integer max_segcount
+
+
+! Start of routine
+
+        this_comp_id = comp_id(gsmap)
+        nprocs=ThisMCTWorld%nprocspid(this_comp_id)
+
+        allocate( segcount(nprocs), stat=ier )
+        if (ier/=0) call die(myname_,'allocate segcount')
+
+        segcount=0
+
+        this_ngseg=ngseg(gsmap)
+
+        do i=1,this_ngseg
+
+          segment_pe = gsmap%pe_loc(i) + 1     ! want value 1..nprocs
+
+          if (segment_pe < 1 .OR. segment_pe > nprocs) then
+            call die(myname_,'bad segment location',segment_pe)
+          endif
+
+          segcount(segment_pe) = segcount(segment_pe) + 1
+        enddo
+
+        max_segcount=0
+        do i=1,nprocs
+          max_segcount= max( max_segcount, segcount(i) )
+        enddo
+
+        deallocate(segcount, stat=ier)
+        if (ier/=0) call die(myname_,'deallocate segcount')
+
+
+        max_nlseg_=max_segcount
+
+        end function max_nlseg_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: comp_id_ - Return the commponent ID from the GlobalSegMap.
+!
+! !DESCRIPTION:
+! The function {\tt comp\_id\_()} returns component ID number stored in
+! {\tt GSMap\%comp\_id}.
+!
+! !INTERFACE:
+
+ integer function comp_id_(GSMap)
+
+! !USES:
+
+      use m_die,only: die
+      use m_stdio, only :stderr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: GSMap
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	26Jan01 - J.W. Larson <larson@mcs.anl.gov> - renamed comp_id_
+!                 to fit within MCT_World component ID context.
+!       01May01 - R.L. Jacob  <jacob@mcs.anl.gov> - make sure GSMap
+!                 is defined.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::comp_id_'
+
+  if(.not.associated(GSMap%start) ) then
+    write(stderr,'(2a)') myname_, &
+    ' MCTERROR:  GSMap argument not initialized...exiting'
+    call die(myname_)
+  endif
+
+  comp_id_ = GSMap%comp_id
+
+ end function comp_id_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: gsize_ - Return the global vector size from the GlobalSegMap.
+!
+! !DESCRIPTION:
+! The function {\tt gsize\_()} takes the input {\tt GlobalSegMap} 
+! arguement {\tt GSMap} and returns the global vector length stored
+! in {\tt GlobalSegMap\%gsize}.
+!
+! !INTERFACE:
+
+ integer function gsize_(GSMap)
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: GSMap
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::gsize_'
+
+  gsize_=GSMap%gsize
+
+ end function gsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalStorage_ - Return global storage space required.
+!
+! !DESCRIPTION:
+! The function {\tt GlobalStorage\_()} takes the input {\tt GlobalSegMap} 
+! arguement {\tt GSMap} and returns the global storage space required 
+! ({\em i.e.}, the vector length) to hold all the data specified by 
+! {\tt GSMap}.
+!
+! {\bf N.B.:  } If {\tt GSMap} contains halo or masked points, the value 
+! by {\tt GlobalStorage\_()} may differ from {\tt GSMap\%gsize}.
+!
+! !INTERFACE:
+
+ integer function GlobalStorage_(GSMap)
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(in) :: GSMap
+
+! !REVISION HISTORY:
+! 	06Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalStorage_'
+
+  integer :: global_storage, ngseg, n
+
+      ! Return global number of segments:
+
+  ngseg = ngseg_(GSMap)
+
+      ! Initialize global_storage (the total number of points in the
+      ! GlobalSegMap:
+
+  global_storage = 0
+
+      ! Add up the number of points present in the GlobalSegMap:
+
+  do n=1,ngseg
+     global_storage = global_storage + GSMap%length(n)
+  end do
+
+  GlobalStorage_ = global_storage
+
+ end function GlobalStorage_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ProcessStorage_ - Number of points on a given process.
+!
+! !DESCRIPTION:
+! The function {\tt ProcessStorage\_()} takes the input {\tt GlobalSegMap} 
+! arguement {\tt GSMap} and returns the storage space required by process
+! {\tt PEno} ({\em i.e.}, the vector length) to hold all the data specified 
+! by {\tt GSMap}.
+!
+! !INTERFACE:
+
+ integer function ProcessStorage_(GSMap, PEno)
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),intent(in) :: GSMap
+      integer,           intent(in) :: PEno
+
+! !REVISION HISTORY:
+! 	06Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ProcessStorage_'
+
+  integer :: pe_storage, ngseg, n
+
+      ! Return global number of segments:
+
+  ngseg = ngseg_(GSMap)
+
+      ! Initialize pe_storage (the total number of points on process
+      ! PEno in the GlobalSegMap):
+
+  pe_storage = 0
+
+      ! Add up the number of points on process PEno in the GlobalSegMap:
+
+  do n=1,ngseg
+     if(GSMap%pe_loc(n) == PEno) then
+	pe_storage = pe_storage + GSMap%length(n)
+     endif
+  end do
+
+  ProcessStorage_ = pe_storage
+
+ end function ProcessStorage_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: OrderedPoints_ - The grid points on a given process
+!				returned in the assumed MCT order.
+!
+! !DESCRIPTION:
+! The function {\tt OrderedPoints\_()} takes the input {\tt GlobalSegMap} 
+! arguement {\tt GSMap} and returns a vector of the points owned by
+! {\tt PEno}.  {\tt Points} is allocated here.  The calling process
+! is responsible for deallocating the space.
+!
+! !INTERFACE:
+
+    subroutine OrderedPoints_(GSMap, PEno, Points)
+
+!
+! !USES:
+!
+      use m_die,only: die
+
+      implicit none
+
+ ! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in) :: GSMap   ! input GlobalSegMap
+      integer,            intent(in) :: PEno	! input process number
+      integer,dimension(:),pointer   :: Points  ! the vector of points
+
+! !REVISION HISTORY:
+! 	25Apr01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::OrderedPoints_'
+  integer :: nlsegs,mysize,ier,i,j,k
+  integer,dimension(:),allocatable :: mystarts,mylengths
+
+  nlsegs = nlseg(GSMap,PEno)
+  mysize=ProcessStorage(GSMap,PEno)
+
+  allocate(mystarts(nlsegs),mylengths(nlsegs), &
+      Points(mysize),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(mystarts,..)',ier)
+
+! pull out the starts and lengths that PEno owns in the order
+! they appear in the GSMap.
+  j=1
+  do i=1,GSMap%ngseg
+    if(GSMap%pe_loc(i)==PEno) then
+      mystarts(j)=GSMap%start(i)
+      mylengths(j)=GSMap%length(i)
+      j=j+1
+    endif
+  enddo
+
+! now recalculate the values of the grid point numbers
+! based on the starts and lengths
+! form one long vector which is all local GSMap points
+  i=1
+  do j=1,nlsegs
+    do k=1,mylengths(j)
+     Points(i)=mystarts(j)+k-1
+     i=i+1
+    enddo
+  enddo
+
+  deallocate(mystarts,mylengths, stat=ier)
+  if(ier/=0) call die(myname_,'deallocate(mystarts,..)',ier)
+
+ end subroutine OrderedPoints_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize_ - find the local storage size from the map
+!
+! !DESCRIPTION:
+! This function returns the number of points owned by the local process,
+! as defined by the input {\tt GlobalSegMap} argument {\tt GSMap}.  The
+! local process ID is determined through use of the input {\tt INTEGER} 
+! argument {\tt comm}, which is the Fortran handle for the MPI 
+! communicator.
+!
+! !INTERFACE:
+
+ integer function lsize_(GSMap, comm)
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die ,          only : MP_perr_die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in) :: GSMap
+      integer,            intent(in) :: comm
+
+
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 	06Feb01 - J.W. Larson <larson@mcs.anl.gov> - Computed directly
+!                 from the GlobalSegMap, rather than returning a hard-
+!                 wired local attribute. This required the addition of
+!                 the communicator argument.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::lsize_'
+  integer :: ierr, local_size, myID, n, ngseg
+
+        ! Determine local rank myID:
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK',ierr)
+
+        ! Determine global number of segments:
+
+  ngseg = ngseg_(GSMap)
+
+        ! Compute the local size of the distributed vector by summing
+        ! the entries of GSMap%length(:) whose corresponding values in
+        ! GSMap%pe_loc(:) equal the local process ID.  This automatically
+        ! takes into account haloing (if present).
+
+  local_size = 0
+
+  do n=1,ngseg
+     if(GSMap%pe_loc(n) == myID) then
+	local_size = local_size + GSMap%length(n)
+     endif
+  end do
+
+  lsize_ = local_size
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rank1_ - rank which process owns a datum with given global 
+! index.
+!
+! !DESCRIPTION:
+! This routine assumes that there is one process that owns the datum with
+! a given global index.  It should not be used when the input 
+! {\tt GlobalSegMap} argument {\tt GSMap} has been built to incorporate
+! halo points.
+!
+! !INTERFACE:
+
+    subroutine rank1_(GSMap, i_g, rank)
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)  :: GSMap   ! input GlobalSegMap
+      integer,            intent(in)  :: i_g	 ! a global index
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: rank    ! the pe on which this
+                                                 ! element resides
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rank1_'
+  integer :: i,ilc,ile
+
+        ! Initially, set the rank to -1 (invalid).
+  rank=-1	
+
+  do i=1,size(GSMap%start)
+    ilc = GSMap%start(i)
+    ile = ilc + GSMap%length(i) - 1
+
+		! If i_g in [ilc,ile].  Note that i_g := [1:..]
+
+    if(ilc <= i_g .and. i_g <= ile) then
+      rank = GSMap%pe_loc(i)
+      return
+    endif
+  end do
+
+ end subroutine rank1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rankm_ - rank which processes own a datum with given global 
+! index.
+!
+! !DESCRIPTION:
+! This routine assumes that there may be more than one process that owns 
+! the datum with a given global index.  This routine should  be used when 
+! the input {\tt GlobalSegMap} argument {\tt GSMap} has been built to 
+! incorporate ! halo points.  {\em Nota Bene}:  The output array {\tt rank} 
+! is allocated in this routine and must be deallocated by the routine calling 
+! {\tt rankm\_()}.  Failure to do so could result in a memory leak.
+!
+! !INTERFACE:
+
+    subroutine rankm_(GSMap, i_g, num_loc, rank)
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)  :: GSMap   ! input GlobalSegMap
+      integer,            intent(in)  :: i_g	 ! a global index
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: num_loc ! the number of processes
+                                                 ! which own element i_g
+      integer, dimension(:), pointer  :: rank    ! the process(es) on which 
+                                                 ! element i_g resides
+! !REVISION HISTORY:
+! 	29Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rankm_'
+  integer :: i, ilc, ile, ier, n
+
+        ! First sweep:  determine the number of processes num_loc 
+        ! that own the given datum:
+
+  num_loc = 0
+
+  do i=1,size(GSMap%start)
+
+    ilc = GSMap%start(i)
+    ile = ilc + GSMap%length(i) - 1
+
+		! If i_g in [ilc,ile].  Note that i_g := [1:..]
+
+    if(ilc <= i_g .and. i_g <= ile) then
+      num_loc = num_loc + 1
+    endif
+
+  end do
+
+  if(num_loc == 0) then
+
+        ! If i_g is nowhere to be found in GSMap, set num_loc to
+        ! unity and return a null value for rank
+
+     num_loc = 1
+     allocate(rank(num_loc), stat=ier)
+     rank = -1	! null value
+     return
+
+  else
+        ! Allocate output array rank(1:num_loc)
+
+     allocate(rank(num_loc), stat=ier)
+
+        ! Second sweep:  fill in the entries to rank(:)
+
+     n = 0 ! counter
+
+     do i=1,size(GSMap%start)
+
+	ilc = GSMap%start(i)
+	ile = ilc + GSMap%length(i) - 1
+
+	! If i_g in [ilc,ile].  Note that i_g := [1:..]
+
+	if(ilc <= i_g .and. i_g <= ile) then
+	   n = n + 1
+	   rank(n) = GSMap%pe_loc(i)
+	endif
+
+     end do
+
+  endif
+
+ end subroutine rankm_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: active_pes_ - number of processes that own data.
+! index.
+!
+! !DESCRIPTION:
+! This routine scans the pe location list of the input {\tt GlobalSegMap}
+! {\tt GSMap\%pe\_loc(:)}, and counts the number of pe locations that
+! own at least one datum.  This value is returned in the {\tt INTEGER} 
+! argument {\tt n\_active}.  If the optional {\tt INTEGER} array argument
+! {\tt list} is included in the call, a sorted list (in ascending order) of 
+! the active processes will be returned.
+!
+! {\bf N.B.:} If {\tt active\_pes\_()} is invoked with the optional argument
+! {\tt pe\_list} included, this routine will allocate and return this array.
+! The user must deallocate this array once it is no longer needed.  Failure
+! to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+    subroutine active_pes_(GSMap, n_active, pe_list)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_SortingTools , only : IndexSet
+      use m_SortingTools , only : IndexSort
+      use m_SortingTools , only : Permute
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),    intent(in)        :: GSMap 
+
+! !OUTPUT PARAMETERS: 
+
+      integer,               intent(out)       :: n_active
+      integer, dimension(:), pointer, optional :: pe_list
+
+! !REVISION HISTORY:
+! 	03Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::active_pes_'
+
+  integer :: count, i, n, ngseg, ierr
+  logical :: new
+  integer, dimension(:), allocatable :: temp_list
+  integer, dimension(:), allocatable :: perm
+
+        ! retrieve total number of segments in the map:
+
+  ngseg = ngseg_(GSMap)
+
+        ! allocate workspace to tally process id list:
+
+  allocate(temp_list(ngseg), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate(temp_list...',ierr)
+ 
+        ! initialize temp_list to -1 (which can never be a process id)
+
+  temp_list = -1
+
+        ! initialize the distinct active process count:
+
+  count = 0
+
+        ! scan entries of GSMap%pe_loc to count active processes:
+
+  do n=1,ngseg
+     if(GSMap%pe_loc(n) >= 0) then ! a legitimate pe_location
+
+	! assume initially that GSMap%pe_loc(n) is a process id previously
+        ! not encountered
+
+	new = .true.
+
+	! test this proposition against the growing list of distinct
+        ! process ids stored in temp_list(:)
+
+	do i=1, count
+	   if(GSMap%pe_loc(n) == temp_list(i)) new = .false.
+	end do
+
+        ! If GSMap%pe_loc(n) represents a previously unencountered 
+        ! process id, increment the count, and add this id to the list
+
+	if(new) then
+	   count = count + 1
+	   temp_list(count) = GSMap%pe_loc(n)
+	endif
+
+     else  ! a negative entry in GSMap%pe_loc(n)
+	ierr = 2
+	call die(myname_,'negative value of GSMap%pe_loc',ierr)
+     endif
+  end do
+
+        ! If the argument pe_list is present, we must allocate this
+        ! array, fill it, and sort it
+
+  if(present(pe_list)) then
+
+        ! allocate pe_list and permutation array perm
+
+     allocate(pe_list(count), perm(count), stat=ierr)
+     if (ierr /= 0) then
+	call die(myname_,'allocate(pe_list...',ierr)
+     endif
+
+     do n=1,count
+	pe_list(n) = temp_list(n)
+     end do
+
+        ! sorting and permutation...
+
+     call IndexSet(perm)
+     call IndexSort(count, perm, pe_list, descend=.false.)
+     call Permute(pe_list, perm, count)
+
+        ! deallocate permutation array...
+
+     deallocate(perm, stat=ierr)
+     if (ierr /= 0) then
+	call die(myname_,'deallocate(perm)',ierr)
+     endif
+
+  endif ! if(present(pe_list))...
+
+        ! deallocate work array temp_list...
+
+  deallocate(temp_list, stat=ierr)
+  if (ierr /= 0) then
+     call die(myname_,'deallocate(temp_list)',ierr)
+  endif
+
+        ! finally, store the active process count in output variable
+        ! n_active:
+
+  n_active = count
+
+ end subroutine active_pes_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: peLocs_ - process ID locations for distributed points.
+! index.
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt INTEGER} array of point indices 
+! {\tt points(:)}, compares them with an input {\tt GlobalSegMap} 
+! {\tt pointGSMap}, and returns the {\em unique} process ID location 
+! for each point.  Note the emphasize on unique.  The assumption here
+! (which is tested) is that {\tt pointGSMap} is not haloed.  The process
+! ID locations for the points is returned in the array {\tt pe\_locs(:)}.
+!
+! {\bf N.B.:} The test of {\tt pointGSMap} for halo points, and the 
+! subsequent search for the process ID for each point is very slow.  This
+! first version of the routine is serial.  A parallel version of this 
+! routine will need to be developed.
+!
+! !INTERFACE:
+
+ subroutine peLocs_(pointGSMap, npoints, points, pe_locs)
+!
+! !USES:
+!
+      use m_die ,          only : die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),    intent(in)   :: pointGSMap 
+      integer,               intent(in)   :: npoints
+      integer, dimension(:), intent(in)   :: points
+
+! !OUTPUT PARAMETERS: 
+
+      integer, dimension(:), intent(out)  :: pe_locs
+
+! !REVISION HISTORY:
+! 	18Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::peLocs_'
+  integer :: ierr
+  integer :: iseg, ngseg, ipoint
+  integer :: lower_index, upper_index
+
+! Input argument checks:
+
+  if(size(points) < npoints) then
+     ierr = size(points)
+     call die(myname_,'input points list array too small',ierr)
+  endif
+
+  if(size(pe_locs) < npoints) then
+     ierr = size(pe_locs)
+     call die(myname_,'output pe_locs array too small',ierr)
+  endif
+
+  if(haloed_(pointGSMap)) then
+     ierr = 1
+     call die(myname_,'input pointGSMap haloed--not valid',ierr)
+  endif
+
+! Brute-force indexing...no assumptions regarding sorting of points(:) 
+! or pointGSMap%start(:)
+
+! Number of segments in pointGSMap:
+
+  ngseg = ngseg_(pointGSMap)
+
+  do ipoint=1,npoints ! loop over points
+
+     do iseg=1,ngseg  ! loop over segments
+
+	lower_index = pointGSMap%start(iseg)
+	upper_index = lower_index + pointGSMap%length(iseg) - 1
+
+	if((points(ipoint) >= lower_index) .and. &
+	     (points(ipoint) <= upper_index)) then
+	   pe_locs(ipoint) = pointGSMap%pe_loc(iseg)
+	endif
+     
+     end do ! do iseg=1, ngseg
+  end do ! do ipoint=1,npoints
+
+ end subroutine peLocs_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: haloed_ - test GlobalSegMap for presence of halo points.
+! index.
+!
+! !DESCRIPTION:
+! This {\tt LOGICAL} function tests the input {\tt GlobalSegMap}
+! {\tt GSMap} for the presence of halo points.  Halo points are points 
+! that appear in more than one segment of a {\tt GlobalSegMap}.  If 
+! {\em any} halo point is found, the function {\tt haloed\_()} returns 
+! immediately with value {\tt .TRUE.}  If, after an exhaustive search 
+! of the map has been completed, no halo points are found, the function 
+! {\tt haloed\_()} returns with value {\tt .FALSE.}
+!
+! The search algorithm is:
+!
+! \begin{enumerate}
+! \item Extract the segment start and length information from 
+! {\tt GSMap\%start} and {\tt GSMap\%length} into the temporary
+! arrays {\tt start(:)} and {\tt length(:)}.
+! \item Sort these arrays in {\em ascending order} keyed by {\tt start}.
+! \item Scan the arrays {\tt start} and{\tt length}.  A halo point is 
+! present if for at least one value of the index 
+! $1 \leq {\tt n} \leq {\tt GSMap\%ngseg}$
+! $${\tt start(n)} + {\tt length(n)} - 1 \geq {\tt start(n+1)}$$.
+! \end{enumerate}
+!
+! {\bf N.B.:} Beware that the search for halo points is potentially 
+! expensive.  
+!
+! !INTERFACE:
+
+    logical function haloed_(GSMap)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_SortingTools , only : IndexSet
+      use m_SortingTools , only : IndexSort
+      use m_SortingTools , only : Permute
+
+      implicit none
+
+ ! !INPUT PARAMETERS:
+
+     type(GlobalSegMap), intent(in)           :: GSMap 
+
+! !REVISION HISTORY:
+! 	08Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! 	26Apr01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::haloed_'
+
+! Error Flag
+
+  integer :: ierr
+
+! Loop index and storage for number of segments in GSMap
+
+  integer :: n, ngseg
+
+! Temporary storage for GSMap%start, GSMap%length, and index 
+! permutation array:
+
+  integer, dimension(:), allocatable :: start, length, perm
+
+! Logical flag indicating segment overlap
+
+  logical :: overlap
+
+       ! How many segments in GSMap?
+
+  ngseg = ngseg_(GSMap)
+
+       ! allocate temporary arrays:
+
+  allocate(start(ngseg), length(ngseg), perm(ngseg), stat=ierr)
+  if (ierr /= 0) then
+     call die(myname_,'allocate(start...',ierr)
+  endif
+
+       ! Fill the temporary arrays start(:) and length(:)
+
+  do n=1,ngseg
+     start(n) = GSMap%start(n)
+     length(n) = GSMap%length(n)
+  end do
+
+       ! Initialize the index permutation array:
+
+  call IndexSet(perm)
+
+       ! Create the index permutation that will order the data so the
+       ! entries of start(:) appear in ascending order:
+
+  call IndexSort(ngseg, perm, start, descend=.false.)
+
+       ! Permute the data so the entries of start(:) are now in 
+       ! ascending order:
+
+  call Permute(start,perm,ngseg)
+
+       ! Apply this same permutation to length(:)
+
+  call Permute(length,perm,ngseg)
+
+       ! Set LOGICAL flag indicating segment overlap to .FALSE.
+
+  overlap = .FALSE.
+
+       ! Now, scan the segments, looking for overlapping segments.  Upon
+       ! discovery of the first overlapping pair of segments, set the
+       ! flag overlap to .TRUE. and exit.
+
+  n = 0
+
+  SCAN_LOOP: do
+     n = n + 1
+     if(n == ngseg) EXIT ! we are finished, and there were no halo pts.
+     if((start(n) + length(n) - 1) >= start(n+1)) then ! found overlap
+	overlap = .TRUE.
+	EXIT
+     endif
+  end do SCAN_LOOP
+
+       ! Clean up allocated memory:
+
+  deallocate(start, length, perm, stat=ierr)
+  if (ierr /= 0) then
+     call die(myname_,'deallocate(start...',ierr)
+  endif
+
+       ! Assign function return value:
+
+ haloed_ = overlap
+
+ end function haloed_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Sort_ - generate index permutation for GlobalSegMap.
+!
+! !DESCRIPTION:
+! {\tt Sort\_()} uses the supplied keys {\tt key1} and {\tt key2} to 
+! generate a permutation {\tt perm} that will put the entries of the 
+! components {\tt GlobalSegMap\%start}, {\tt GlobalSegMap\%length} and
+! {\tt GlobalSegMap\%pe\_loc} in {\em ascending} lexicographic order.
+!
+! {\bf N.B.:} {\tt Sort\_()} returns an allocated array {\tt perm(:)}.  It
+! the user must deallocate this array once it is no longer needed.  Failure
+! to do so could create a memory leak.
+!
+! !INTERFACE:
+
+    subroutine Sort_(GSMap, key1, key2, perm)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_SortingTools , only : IndexSet
+      use m_SortingTools , only : IndexSort
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),    intent(in)           :: GSMap ! input GlobalSegMap
+      integer, dimension(:), intent(in)           :: key1  ! first sort key
+      integer, dimension(:), intent(in), optional :: key2  ! second sort key
+
+! !OUTPUT PARAMETERS:
+
+      integer, dimension(:), pointer :: perm    ! output index permutation
+
+! !REVISION HISTORY:
+! 	02Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Sort_'
+
+  integer :: ierr, length
+
+  length = ngseg_(GSMap)
+
+        ! Argument checking.  are key1 and key2 (if supplied) the
+        ! same length as the components of GSMap?  If not, stop with
+        ! an error.
+
+  ierr = 0
+
+  if(size(key1) /= length) then
+     ierr = 1
+     call die(myname_,'key1 GSMap size mismatch',ierr)
+  endif
+
+  if(present(key2)) then
+     if(size(key2) /= length) then
+        ierr = 2
+	call die(myname_,'key2 GSMap size mismatch',ierr)
+     endif
+     if(size(key1) /= size(key2)) then
+        ierr = 3
+	call die(myname_,'key1 key2 size mismatch',ierr)
+     endif
+  endif
+
+        ! allocate space for permutation array perm(:)
+
+  allocate(perm(length), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate(perm)',ierr)
+
+        ! Initialize perm(i)=i, for i=1,length
+
+  call IndexSet(perm)
+ 
+        ! Index permutation is achieved by successive calls to IndexSort(),
+        ! with the keys supplied one at a time in the order reversed from
+        ! the desired sort order.
+
+  if(present(key2)) then
+     call IndexSort(length, perm, key2, descend=.false.)
+  endif
+
+  call IndexSort(length, perm, key1, descend=.false.)
+
+        ! Yes, it is that simple.  The desired index permutation is now
+        ! stored in perm(:)
+
+ end subroutine Sort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PermuteInPlace_ - apply index permutation to GlobalSegMap.
+!
+! !DESCRIPTION:
+! {\tt PermuteInPlace\_()} uses a supplied index permutation {\tt perm} 
+! to re-order {\tt GlobalSegMap\%start}, {\tt GlobalSegMap\%length} and
+! {\tt GlobalSegMap\%pe\_loc}.
+!
+! !INTERFACE:
+
+    subroutine PermuteInPlace_(GSMap, perm)
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_SortingTools , only : Permute
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, dimension(:), intent(in) :: perm
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(inout) :: GSMap
+
+! !REVISION HISTORY:
+!       02Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PermuteInPlace_'
+
+  integer :: length, ierr
+
+  length = ngseg_(GSMap)
+
+        ! Argument checking.  Do the components of GSMap
+        ! (e.g. GSMap%start) have the same length as the
+        ! permutation array perm?  If not, stop with an error.
+
+  ierr = 0
+
+  if(size(perm) /= length) then
+     ierr = 1
+     call die(myname_,'perm GSMap size mismatch',ierr)
+  endif
+
+        ! In-place index permutation using perm(:) :
+
+  call Permute(GSMap%start,perm,length)
+  call Permute(GSMap%length,perm,length)
+  call Permute(GSMap%pe_loc,perm,length)
+
+        ! Now, the components of GSMap are ordered according to
+        ! perm(:).
+
+ end subroutine PermuteInPlace_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SortPermuteInPlace_ - Sort in-place GlobalSegMap components.
+!
+! !DESCRIPTION:
+! {\tt SortPermuteInPlace\_()} uses a the supplied key(s) to generate 
+! and apply an index permutation that will place the {\tt GlobalSegMap}
+! components {\tt GlobalSegMap\%start}, {\tt GlobalSegMap\%length} and
+! {\tt GlobalSegMap\%pe\_loc} in lexicographic order.
+!
+! !INTERFACE:
+
+    subroutine SortPermuteInPlace_(GSMap, key1, key2)
+!
+! !USES:
+!
+      use m_die ,          only : die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer, dimension(:), intent(in)           :: key1
+      integer, dimension(:), intent(in), optional :: key2
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap),    intent(inout)        :: GSMap
+
+! !REVISION HISTORY:
+!       02Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SortPermuteInPlace_'
+
+  integer :: length, ierr
+  integer, dimension(:), pointer :: perm
+
+   length = ngseg_(GSMap)
+
+        ! Argument checking.  are key1 and key2 (if supplied) the
+        ! same length as the components of GSMap?  If not, stop with
+        ! an error.
+  ierr = 0
+  if(size(key1) /= length) then
+     ierr = 1
+     call die(myname_,'key1 GSMap size mismatch',ierr)
+  endif
+
+  if(present(key2)) then
+     if(size(key2) /= length) then
+        ierr = 2
+	call die(myname_,'key2 GSMap size mismatch',ierr)
+     endif
+     if(size(key1) /= size(key2)) then
+        ierr = 3
+	call die(myname_,'key1 key2 size mismatch',ierr)
+     endif
+  endif
+
+        ! Generate desired index permutation:      
+
+  if(present(key2)) then
+     call Sort_(GSMap, key1, key2, perm)
+  else
+     call Sort_(GSMap, key1=key1, perm=perm)
+  endif
+
+        ! Apply index permutation:      
+
+  call PermuteInPlace_(GSMap, perm)
+
+        ! Now the components of GSMap have been re-ordered.
+        ! Deallocate the index permutation array perm(:)
+
+  deallocate(perm, stat=ierr)
+  if(ierr /= 0) call die(myname_,'deallocate(perm...)',ierr)
+
+ end subroutine SortPermuteInPlace_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: increasing_ - Return .TRUE. if GSMap has increasing indices
+!
+! !DESCRIPTION:
+! The function {\tt increasing\_()} returns .TRUE. if each proc's
+! indices in the {\tt GlobalSegMap} argument {\tt GSMap} have 
+! strictly increasing indices.  I.e. the proc's segments have indices
+! in ascending order and are non-overlapping.
+!
+! !INTERFACE:
+
+ logical function increasing_(gsmap)
+
+! !USES:
+      use m_MCTWorld, only: ThisMCTWorld
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: gsmap
+
+! !REVISION HISTORY:
+! 	06Jun07 - R. Loy <rloy@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::increasing_'
+
+  integer comp_id
+  integer nprocs
+  integer i
+  integer this_ngseg
+  integer ier
+  integer, allocatable:: last_index(:)
+  integer pe_loc
+
+  comp_id = gsmap%comp_id
+  nprocs=ThisMCTWorld%nprocspid(comp_id)
+
+  allocate( last_index(nprocs), stat=ier )
+  if (ier/=0) call die(myname_,'allocate last_index')
+
+  last_index= -1
+  increasing_ = .TRUE.
+  this_ngseg=ngseg(gsmap)
+
+  iloop: do i=1,this_ngseg
+    pe_loc=gsmap%pe_loc(i)+1  ! want value 1..nprocs
+    if (gsmap%start(i) <= last_index(pe_loc)) then
+      increasing_ = .FALSE.
+      exit iloop
+    endif
+    last_index(pe_loc)=gsmap%start(i)+gsmap%length(i)-1
+  enddo iloop
+
+  deallocate( last_index, stat=ier )
+  if (ier/=0) call die(myname_,'deallocate last_index')
+
+ end function increasing_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: copy_ - Copy the gsmap to a new gsmap
+!
+! !DESCRIPTION:
+! Make a copy of a gsmap.
+! Note this is a deep copy of all arrays.
+!
+! !INTERFACE:
+
+  subroutine copy_(src,dest)
+
+! !USES:
+      use m_MCTWorld, only: ThisMCTWorld
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(in) :: src
+
+! !OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap),intent(out) :: dest
+
+
+! !REVISION HISTORY:
+! 	27Jul07 - R. Loy <rloy@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+
+    call initp_( dest, src%comp_id, src%ngseg, src%gsize, &
+                 src%start, src%length, src%pe_loc )
+
+  end subroutine copy_
+
+ end module m_GlobalSegMap
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMapComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMapComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalSegMapComms.F90	(revision 4775)
@@ -0,0 +1,555 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GlobalSegMapComms.F90,v 1.6 2004-04-23 23:58:47 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GlobalSegMapComms - GlobalSegMap Communications Support
+!
+! !DESCRIPTION:
+!
+! This module provides communications support for the {\tt GlobalSegMap} 
+! datatype.  Both blocking and non-blocking point-to-point communications 
+! are provided for send (analogues to {\tt MPI\_SEND()/MPI\_ISEND()})
+! A receive and broadcast method is also supplied.
+!
+! !INTERFACE:
+
+ module m_GlobalSegMapComms
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: send
+      public :: recv
+      public :: isend
+      public :: bcast
+
+      interface bcast ; module procedure bcast_ ; end interface
+      interface send  ; module procedure send_  ; end interface
+      interface recv  ; module procedure recv_  ; end interface
+      interface isend ; module procedure isend_ ; end interface
+
+! !REVISION HISTORY:
+! 11Aug03 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_GlobalSegMapComms'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: send_ - Point-to-point blocking Send of a GlobalSegMap
+!
+! !DESCRIPTION:
+! This routine performs a blocking send of a {\tt GlobalSegMap} (the 
+! input argument {\tt outgoingGSMap}) to the root processor on component
+! {\tt comp\_id}. The input {\tt INTEGER} argument {\tt TagBase} 
+! is used to generate tags for the messages associated with this operation; 
+! there are six messages involved, so the user should avoid using tag 
+! values {\tt TagBase} and {\tt TagBase + 5}.  All six messages are blocking.
+! The success (failure) of this operation is reported in the zero 
+! (non-zero) value of the optional {\tt INTEGER} output variable {\tt status}.
+!
+! !INTERFACE:
+
+ subroutine send_(outgoingGSMap, comp_id, TagBase, status)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : MP_perr_die,die
+      use m_stdio
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_comp_id => comp_ID
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+
+      use m_MCTWorld, only : ComponentToWorldRank
+      use m_MCTWorld, only : ThisMCTWorld
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+  type(GlobalSegMap),    intent(IN)  :: outgoingGSMap
+  integer,               intent(IN)  :: comp_id
+  integer,               intent(IN)  :: TagBase
+
+! !OUTPUT PARAMETERS: 
+
+  integer, optional,     intent(OUT) :: status
+
+! !REVISION HISTORY:
+! 13Aug03 - J.W. Larson <larson@mcs.anl.gov> - API and initial version.
+! 26Aug03 - R. Jacob <jacob@mcs.anl.gov> - use same method as isend_
+! 05Mar04 - R. Jacob <jacob@mcs.anl.gov> - match new isend_ method.
+!EOP ___________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::send_'
+
+  integer :: ierr
+  integer :: destID
+  integer :: nsegs
+
+  if(present(status)) status = 0 ! the success value
+
+  destID = ComponentToWorldRank(0, comp_id, ThisMCTWorld)
+
+       ! Next, send the buffer size to destID so it can prepare a
+       ! receive buffer of the correct size.
+  nsegs = GlobalSegMap_ngseg(outgoingGSMap)
+
+  call MPI_SEND(outgoingGSMap%comp_id, 1, MP_Type(outgoingGSMap%comp_id), destID, &
+                TagBase, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send compid failed',ierr)
+  endif
+
+  call MPI_SEND(outgoingGSMap%ngseg, 1, MP_Type(outgoingGSMap%ngseg), destID, &
+                TagBase+1, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send ngseg failed',ierr)
+  endif
+
+  call MPI_SEND(outgoingGSMap%gsize, 1, MP_Type(outgoingGSMap%gsize), destID, &
+                TagBase+2, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send gsize failed',ierr)
+  endif
+
+
+       ! Send segment information data (3 messages)
+
+  call MPI_SEND(outgoingGSMap%start, nsegs, &
+                MP_Type(outgoingGSMap%start(1)), &
+                destID, TagBase+3, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%start failed',ierr)
+  endif
+
+  call MPI_SEND(outgoingGSMap%length, nsegs, &
+                MP_Type(outgoingGSMap%length(1)), &
+                destID, TagBase+4, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%length failed',ierr)
+  endif
+
+  call MPI_SEND(outgoingGSMap%pe_loc, nsegs, &
+                MP_Type(outgoingGSMap%pe_loc(1)), &
+                destID, TagBase+5, ThisMCTWorld%MCT_comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%pe_loc failed',ierr)
+  endif
+
+ end subroutine send_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: isend_ - Point-to-point Non-blocking Send of a GlobalSegMap
+!
+! !DESCRIPTION:
+! This routine performs a non-blocking send of a {\tt GlobalSegMap} (the 
+! input argument {\tt outgoingGSMap}) to the root processor on component
+! {\tt comp\_id}  The input {\tt INTEGER} argument {\tt TagBase} 
+! is used to generate tags for the messages associated with this operation; 
+! there are six messages involved, so the user should avoid using tag 
+! values {\tt TagBase} and {\tt TagBase + 5}.  All six messages are non-
+! blocking, and the request handles for them are returned in the output
+! {\tt INTEGER} array {\tt reqHandle}, which can be checked for completion 
+! using any of MPI's wait functions.  The success (failure) of 
+! this operation is reported in the zero (non-zero) value of the optional 
+! {\tt INTEGER} output variable {\tt status}.
+!
+! {\bf N.B.}:  Data is sent directly out of {\tt outgoingGSMap} so it
+! must not be deleted until the send has completed.
+!
+! {\bf N.B.}:  The array {\tt reqHandle} represents allocated memory that 
+! must be deallocated when it is no longer needed.  Failure to do so will 
+! create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine isend_(outgoingGSMap, comp_id, TagBase, reqHandle, status)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : MP_perr_die,die
+      use m_stdio
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+
+      use m_MCTWorld, only : ComponentToWorldRank
+      use m_MCTWorld, only : ThisMCTWorld
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+  type(GlobalSegMap),    intent(IN)  :: outgoingGSMap
+  integer,               intent(IN)  :: comp_id
+  integer,               intent(IN)  :: TagBase
+
+! !OUTPUT PARAMETERS: 
+
+  integer, dimension(:), pointer     :: reqHandle
+  integer, optional,     intent(OUT) :: status
+
+! !REVISION HISTORY:
+! 13Aug03 - J.W. Larson <larson@mcs.anl.gov> - API and initial version.
+! 05Mar04 - R. Jacob <jacob@mcs.anl.gov> - Send everything directly out
+!           of input GSMap.  Don't use a SendBuffer.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::isend_'
+
+  integer :: ierr,destID,nsegs
+
+  if(present(status)) status = 0 ! the success value
+
+  destID = ComponentToWorldRank(0, comp_id, ThisMCTWorld)
+
+  allocate(reqHandle(6), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  'FATAL--allocation of send buffer failed with ierr=',ierr
+     call die(myname_)
+  endif
+
+       ! Next, send the buffer size to destID so it can prepare a
+       ! receive buffer of the correct size (3 messages).
+  nsegs = GlobalSegMap_ngseg(outgoingGSMap)
+
+  call MPI_ISEND(outgoingGSMap%comp_id, 1, MP_Type(outgoingGSMap%comp_id), destID, &
+                TagBase, ThisMCTWorld%MCT_comm, reqHandle(1), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send compid failed',ierr)
+  endif
+
+  call MPI_ISEND(outgoingGSMap%ngseg, 1, MP_Type(outgoingGSMap%ngseg), destID, &
+                TagBase+1, ThisMCTWorld%MCT_comm, reqHandle(2), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send ngseg failed',ierr)
+  endif
+
+  call MPI_ISEND(outgoingGSMap%gsize, 1, MP_Type(outgoingGSMap%gsize), destID, &
+                TagBase+2, ThisMCTWorld%MCT_comm, reqHandle(3), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send gsize failed',ierr)
+  endif
+
+       ! Send segment information data (3 messages)
+
+  call MPI_ISEND(outgoingGSMap%start, nsegs, &
+                MP_Type(outgoingGSMap%start(1)), &
+                destID, TagBase+3, ThisMCTWorld%MCT_comm, reqHandle(4), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%start failed',ierr)
+  endif
+
+  call MPI_ISEND(outgoingGSMap%length, nsegs, &
+                MP_Type(outgoingGSMap%length(1)), &
+                destID, TagBase+4, ThisMCTWorld%MCT_comm, reqHandle(5), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%length failed',ierr)
+  endif
+
+  call MPI_ISEND(outgoingGSMap%pe_loc, nsegs, &
+                MP_Type(outgoingGSMap%pe_loc(1)), &
+                destID, TagBase+5, ThisMCTWorld%MCT_comm, reqHandle(6), ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Send outgoingGSMap%pe_loc failed',ierr)
+  endif
+
+ end subroutine isend_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: recv_ - Point-to-point blocking Receive of a GlobalSegMap
+!
+! !DESCRIPTION:
+! This routine performs a blocking receive of a {\tt GlobalSegMap} (the 
+! input argument {\tt outgoingGSMap}) from the root processor on component
+! {\tt comp\_id}. The input {\tt INTEGER} argument {\tt TagBase} 
+! is used to generate tags for the messages associated with this operation; 
+! there are six messages involved, so the user should avoid using tag 
+! values {\tt TagBase} and {\tt TagBase + 5}. The success (failure) of this
+! operation is reported in the zero (non-zero) value of the optional {\tt INTEGER} 
+! output variable {\tt status}.
+!
+! !INTERFACE:
+
+ subroutine recv_(incomingGSMap, comp_id, TagBase, status)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : MP_perr_die, die
+      use m_stdio
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+
+      use m_MCTWorld, only : ComponentToWorldRank
+      use m_MCTWorld, only : ThisMCTWorld
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+  integer,               intent(IN)  :: comp_id
+  integer,               intent(IN)  :: TagBase
+
+! !OUTPUT PARAMETERS: 
+
+  type(GlobalSegMap),    intent(OUT) :: incomingGSMap
+  integer, optional,     intent(OUT) :: status
+
+! !REVISION HISTORY:
+! 13Aug03 - J.W. Larson <larson@mcs.anl.gov> - API and initial version.
+! 25Aug03 - R.Jacob <larson@mcs.anl.gov> - rename to recv_.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::recv_'
+
+  integer :: ierr,sourceID
+  integer :: MPstatus(MP_STATUS_SIZE)
+  integer :: RecvBuffer(3)
+
+  if(present(status)) status = 0 ! the success value
+
+  sourceID = ComponentToWorldRank(0, comp_id, ThisMCTWorld)
+
+       ! Receive the GlobalSegMap's basic constants:  component id,
+       ! grid size, and number of segments.  The number of segments
+       ! is needed to construct the arrays into which segment 
+       ! information will be received.  Thus, this receive blocks.
+
+  call MPI_RECV(RecvBuffer(1), 1, MP_Type(RecvBuffer(1)), sourceID, &
+                TagBase, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Receive of compid failed',ierr)
+  endif
+  call MPI_RECV(RecvBuffer(2), 1, MP_Type(RecvBuffer(2)), sourceID, &
+                TagBase+1, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Receive of ngseg failed',ierr)
+  endif
+  call MPI_RECV(RecvBuffer(3), 1, MP_Type(RecvBuffer(3)), sourceID, &
+                TagBase+2, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Receive of gsize failed',ierr)
+  endif
+
+       ! Create Empty GlobaSegMap into which segment information
+       ! will be received
+
+  call GlobalSegMap_init(incomingGSMap, RecvBuffer(1), RecvBuffer(2), &
+                         RecvBuffer(3))
+
+       ! Receive segment information data (3 messages)
+
+  call MPI_RECV(incomingGSMap%start, RecvBuffer(2), &
+                MP_Type(incomingGSMap%start(1)), &
+                sourceID, TagBase+3, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Recv incomingGSMap%start failed',ierr)
+  endif
+
+  call MPI_RECV(incomingGSMap%length, RecvBuffer(2), &
+                MP_Type(incomingGSMap%length(1)), &
+                sourceID, TagBase+4, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Recv incomingGSMap%length failed',ierr)
+  endif
+
+  call MPI_RECV(incomingGSMap%pe_loc, RecvBuffer(2), &
+                MP_Type(incomingGSMap%pe_loc(1)), &
+                sourceID, TagBase+5, ThisMCTWorld%MCT_comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_, 'Recv incomingGSMap%pe_loc failed',ierr)
+  endif
+
+ end subroutine recv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - broadcast a GlobalSegMap object
+!
+! !DESCRIPTION:
+!
+! The routine {\tt bcast\_()} takes the input/output {\em GlobalSegMap} 
+! argument {\tt GSMap} (on input valid only on the {\tt root} process,
+! on output valid on all processes) and broadcasts it to all processes
+! on the communicator associated with the F90 handle {\tt comm}.  The
+! success (failure) of this operation is returned as a zero (non-zero) 
+! value of the optional output {\tt INTEGER} argument {\tt status}.
+!
+! !INTERFACE:
+
+ subroutine bcast_(GSMap, root, comm, status)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : MP_perr_die,die
+      use m_stdio
+
+      use m_GlobalSegMap, only : GlobalSegMap
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,            intent(in)     :: root
+      integer,            intent(in)     :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(GlobalSegMap), intent(inout)  :: GSMap  ! Output GlobalSegMap
+
+! !OUTPUT PARAMETERS: 
+
+      integer, optional,  intent(out)    :: status ! global vector size
+
+! !REVISION HISTORY:
+! 17Oct01 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+! 11Aug03 - J.W. Larson <larson@mcs.anl.gov> - Relocated from original
+!           location in m_GlobalSegMap.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcast_'
+
+  integer :: myID, ierr, n
+  integer, dimension(:), allocatable :: IntBuffer
+
+       ! Step One:  which process am I?
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ierr)
+
+       ! Step Two:  Broadcast the scalar bits of the GlobalSegMap from
+       ! the root.
+
+  allocate(IntBuffer(3), stat=ierr) ! allocate buffer space (all PEs)
+  if(ierr /= 0) then
+    if(.not. present(status)) then
+       call die(myname_,'allocate(IntBuffer)',ierr)
+    else
+       write(stderr,*) myname_,':: error during allocate(IntBuffer)'
+       status = 2
+       return
+    endif
+  endif
+
+  if(myID == root) then ! pack the buffer
+     IntBuffer(1) = GSMap%comp_id
+     IntBuffer(2) = GSMap%ngseg
+     IntBuffer(3) = GSMap%gsize
+  endif
+
+  call MPI_BCAST(IntBuffer, 3, MP_type(IntBuffer(1)), root, comm, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MPI_BCAST(IntBuffer)',ierr)
+
+  if(myID /= root) then ! unpack from buffer to GSMap
+     GSMap%comp_id = IntBuffer(1)
+     GSMap%ngseg = IntBuffer(2)
+     GSMap%gsize = IntBuffer(3)
+  endif
+
+  deallocate(IntBuffer, stat=ierr) ! deallocate buffer space
+  if(ierr /= 0) then
+    if(.not. present(status)) then
+       call die(myname_,'deallocate(IntBuffer)',ierr)
+    else
+       write(stderr,*) myname_,':: error during deallocate(IntBuffer)'
+       status = 4
+       return
+    endif
+  endif
+
+       ! Step Three:  Broadcast the vector bits of GSMap from the root.
+       ! Pack them into one big array to save latency costs associated
+       ! with multiple broadcasts.
+
+  allocate(IntBuffer(3*GSMap%ngseg), stat=ierr) ! allocate buffer space (all PEs)
+  if(ierr /= 0) then
+    if(.not. present(status)) then
+       call die(myname_,'second allocate(IntBuffer)',ierr)
+    else
+       write(stderr,*) myname_,':: error during second allocate(IntBuffer)'
+       status = 5
+       return
+    endif
+  endif 
+
+  if(myID == root) then ! pack outgoing broadcast buffer
+     do n=1,GSMap%ngseg
+	IntBuffer(n) = GSMap%start(n)
+	IntBuffer(GSMap%ngseg+n) = GSMap%length(n)
+	IntBuffer(2*GSMap%ngseg+n) = GSMap%pe_loc(n)
+     end do
+  endif
+
+  call MPI_BCAST(IntBuffer, 3*GSMap%ngseg, MP_Type(IntBuffer(1)), root, comm, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'Error in second MPI_BCAST(IntBuffer)',ierr)
+
+  if(myID /= root) then ! Allocate GSMap%start, GSMap%length,...and fill them
+
+     allocate(GSMap%start(GSMap%ngseg), GSMap%length(GSMap%ngseg), &
+	      GSMap%pe_loc(GSMap%ngseg), stat=ierr)
+     if(ierr /= 0) then
+	if(.not. present(status)) then
+	   call die(myname_,'off-root allocate(GSMap%start...)',ierr)
+	else
+	   write(stderr,*) myname_,':: error during off-root allocate(GSMap%start...)'
+	   status = 7
+	   return
+	endif
+     endif
+
+     do n=1,GSMap%ngseg ! unpack the buffer into the GlobalSegMap
+	GSMap%start(n) = IntBuffer(n)
+	GSMap%length(n) = IntBuffer(GSMap%ngseg+n)
+	GSMap%pe_loc(n) = IntBuffer(2*GSMap%ngseg+n)
+     end do
+
+  endif
+
+       ! Clean up buffer space:
+
+  deallocate(IntBuffer, stat=ierr) 
+  if(ierr /= 0) then
+    if(.not. present(status)) then
+       call die(myname_,'second deallocate(IntBuffer)',ierr)
+    else
+       write(stderr,*) myname_,':: error during second deallocate(IntBuffer)'
+       status = 8
+       return
+    endif
+  endif 
+
+ end subroutine bcast_
+
+ end module m_GlobalSegMapComms
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalToLocal.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalToLocal.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_GlobalToLocal.F90	(revision 4775)
@@ -0,0 +1,719 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_GlobalToLocal.F90,v 1.16 2006-04-20 23:54:48 rloy Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_GlobalToLocal - Global to Local Index Translation
+!
+! !DESCRIPTION:
+! This module contains routines for translating global array indices 
+! into their local counterparts (that is, the indices into the local 
+! data structure holding a given process' chunk of a distributed array).
+! The MCT domain decomposition descriptors {\tt GlobalMap} and 
+! {\tt GlobalSegMap} are both supported.   Indices can be translated 
+! one-at-a-time using the {\tt GlobalToLocalIndex} routine or many 
+! at once using the {\tt GlobalToLocalIndices} routine.
+!
+! This module also provides facilities for setting the local row and 
+! column indices for a {\tt SparseMatrix} through the 
+! {\tt GlobalToLocalMatrix} routines.
+!
+! !INTERFACE:
+
+ module m_GlobalToLocal
+
+! !USES:
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: GlobalToLocalIndex   ! Translate Global to Local index
+                                     ! (i.e. recover local index for a
+                                     ! point from its global index). 
+
+      public :: GlobalToLocalIndices ! Translate Global to Local indices
+                                     ! (i.e. recover local starts/lengths 
+                                     ! of distributed data segments).
+                                     
+      public :: GlobalToLocalMatrix  ! Re-indexing of row or column
+                                     ! indices for a SparseMatrix
+
+    interface GlobalToLocalIndices ; module procedure   &
+       GlobalSegMapToIndices_,  &   ! local arrays of starts/lengths
+       GlobalSegMapToNavigator_, &  ! return local indices as Navigator
+       GlobalSegMapToIndexArr_
+    end interface
+
+    interface GlobalToLocalIndex ; module procedure &
+       GlobalSegMapToIndex_, &
+       GlobalMapToIndex_
+    end interface
+
+    interface GlobalToLocalMatrix ; module procedure &
+       GlobalSegMapToLocalMatrix_
+    end interface
+
+
+! !SEE ALSO:
+!
+! The MCT modules {\tt m\_GlobalMap} and {m\_GlobalSegMap} for more 
+! information regarding MCT's domain decomposition descriptors.
+!
+! The MCT module {\tt m\_SparseMatrix} for more information regarding 
+! the {\tt SparseMatrix} datatype.
+!
+! !REVISION HISTORY:
+!  2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_GlobalToLocal'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToIndices_ - Return _local_ indices in arrays.
+!
+! !DESCRIPTION:  {\tt GlobalSegMapToIndices\_()} takes a user-supplied
+! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition 
+! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} 
+! handle {\tt comm} to translate the global directory of segment locations 
+! into local indices for referencing the on-pe storage of the mapped 
+! distributed data.
+!
+! {\bf N.B.:}  This routine returns two allocated arrays---{\tt start(:)} 
+! and {\tt length(:)}---which must be deallocated once the user no longer
+! needs them.  Failure to do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine GlobalSegMapToIndices_(GSMap, comm, start, length)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die,          only : MP_perr_die, die, warn
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),   intent(in) :: GSMap ! Output GlobalSegMap
+      integer,              intent(in) :: comm  ! communicator handle
+
+! !OUTPUT PARAMETERS:
+
+      integer,dimension(:), pointer :: start  ! local segment start indices
+      integer,dimension(:), pointer :: length ! local segment sizes
+
+! !REVISION HISTORY:
+!  2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndices_'
+
+  integer :: myID, ierr, ngseg, nlseg, n, count
+ 
+          ! determine local process id myID
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK',ierr)
+
+          ! determine number of global segments ngseg:
+
+  ngseg = GlobalSegMap_ngseg(GSMap)
+
+          ! determine number of local segments on process myID nlseg:
+
+  nlseg = GlobalSegMap_nlseg(GSMap, myID)
+
+          ! allocate arrays start(:) and length(:) to store local
+          ! segment information.
+
+  allocate(start(nlseg), length(nlseg), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate(start...',ierr)
+
+          ! Loop over GlobalSegMap%pe_loc(:) values to isolate
+          ! global index values of local data.  Record number of
+          ! matches in the INTEGER count.
+
+  count = 0
+  do n=1, ngseg
+     if(GSMap%pe_loc(n) == myID) then
+        count = count + 1
+        if(count > nlseg) then
+           ierr = 2
+           call die(myname_,'too many pe matches',ierr)
+	endif
+	start(count) = GSMap%start(n)
+	length(count) = GSMap%length(n)
+     endif
+  end do
+
+  if(count < nlseg) then
+     ierr = 3
+     call die(myname_,'too few pe matches',ierr)
+  endif
+
+          ! translate global start indices to their local 
+          ! values, based on their storage order and number
+          ! of elements in each segment
+
+  do n=1, count
+     if(n == 1) then
+	start(n) = 1
+     else
+	start(n) = start(n-1) + length(n-1)
+     endif
+  end do
+
+ end subroutine GlobalSegMapToIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToIndex_ - Global to Local Index Translation
+!
+! !DESCRIPTION:  This {\tt INTEGER} query function takes a user-supplied
+! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition 
+! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} 
+! handle {\tt comm}, and the input global index value {\tt i\_g}, and 
+! returns a positive local index value if the datum {\tt i\_g}.   If 
+! the datum {\tt i\_g} is not stored on the local process ID, a value 
+! of {\tt -1} is returned.
+!
+! !INTERFACE:
+
+
+ integer function GlobalSegMapToIndex_(GSMap, i_g, comm)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die,          only : MP_perr_die, die, warn
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)  :: GSMap ! Output GlobalSegMap
+      integer,            intent(in)  :: i_g   ! global index
+      integer,            intent(in)  :: comm  ! communicator handle
+
+! !REVISION HISTORY:
+!  2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndex_'
+
+  integer :: myID
+  integer :: count, ierr, ngseg, nlseg, n
+  integer :: lower_bound, upper_bound
+  integer :: local_start, local_index
+  logical :: found
+
+  ! Determine local process id myID:
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr)
+
+  ! Extract the global number of segments in GSMap
+
+  ngseg = GlobalSegMap_ngseg(GSMap)
+
+  ! Extract the global number of segments in GSMap for myID
+
+  nlseg = GlobalSegMap_nlseg(GSMap, myID)
+
+  ! set the counter count, which records the number of times myID
+  ! matches entries in GSMap%pe_loc(:)
+
+  count = 0
+
+  ! set local_start, which is the current local storage segment
+  ! starting position
+
+  local_start = 1
+
+  ! set logical flag found to signify we havent found i_g:
+
+  found = .false.
+
+  n = 0
+
+  SEARCH_LOOP: do 
+     
+     n = n+1
+     if (n > ngseg) EXIT
+
+     if(GSMap%pe_loc(n) == myID) then
+
+  ! increment / check the pe_loc match counter
+
+        count = count + 1
+        if(count > nlseg) then
+           ierr = 2
+           call die(myname_,'too many pe matches',ierr)
+	endif
+
+  ! is i_g in this segment?
+
+        lower_bound = GSMap%start(n)
+        upper_bound = GSMap%start(n) + GSMap%length(n) - 1
+
+        if((lower_bound <= i_g) .and. (i_g <= upper_bound)) then
+	   local_index = local_start + (i_g - GSMap%start(n))
+	   found = .true.
+	   EXIT
+	else
+	   local_start = local_start + GSMap%length(n)
+        endif
+
+     endif
+  end do SEARCH_LOOP
+
+  ! We either found the local index, or have exhausted our options.
+
+  if(found) then
+     GlobalSegMapToIndex_ = local_index
+  else
+     GlobalSegMapToIndex_ = -1
+  endif
+
+ end function GlobalSegMapToIndex_
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToIndexArr_ - Global to Local Index Array Translation
+!
+! !DESCRIPTION:  Given a {\tt GlobalSegMap} data type {\tt GSMap}
+! and MPI communicator corresponding to the Fortran {\tt INTEGER} 
+! handle {\tt comm}, convert an array of global index values
+! {\tt i\_global()} to an array of local index values {\tt i\_local()}.  If 
+! the datum {\tt i\_global(j)} is not stored on the local process ID,
+! then {\tt i\_local(j)} will be set to {\tt -1}/
+!
+! !INTERFACE:
+
+
+subroutine GlobalSegMapToIndexArr_(GSMap, i_global, i_local, nindex, comm)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_mpif90
+      use m_die,          only : MP_perr_die, die, warn
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)  :: GSMap ! Output GlobalSegMap
+      integer,            intent(in)  :: i_global(:)   ! global index
+      integer,            intent(out) :: i_local(:)    ! local index
+      integer,            intent(in)  :: nindex          ! size of i_global()
+      integer,            intent(in)  :: comm  ! communicator handle
+
+! !REVISION HISTORY:
+!  12-apr-2006   R. Loy <rloy@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToIndexArr_'
+
+  integer :: myID
+  integer :: count, ierr, ngseg, nlseg
+  integer,allocatable  :: mygs_lb(:),mygs_ub(:),mygs_len(:),mygs_lstart(:)
+
+  integer :: i,j,n,startj
+
+  ! Determine local process id myID:
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr)
+
+
+  ngseg = GlobalSegMap_ngseg(GSMap)
+  nlseg = GlobalSegMap_nlseg(GSMap, myID)
+
+  if (nlseg <= 0) return;
+
+  allocate( mygs_lb(nlseg), mygs_ub(nlseg), mygs_len(nlseg) )
+  allocate( mygs_lstart(nlseg) )
+
+
+!! 
+!! determine the global segments on this processor 
+!! just once, so the info be used repeatedly below
+!!
+
+  n = 0
+  do i=1,ngseg
+    if (GSMap%pe_loc(i) == myID ) then
+      n=n+1
+      mygs_lb(n)=GSMap%start(i)
+      mygs_ub(n)=GSMap%start(i) + GSMap%length(i) -1
+      mygs_len(n)=GSMap%length(i)
+    endif
+  enddo
+
+  if (n .ne. nlseg) then
+    write(stderr,*) myname_,"mismatch nlseg",n,nlseg
+    call die(myname)
+  endif
+
+  mygs_lstart(1)=1
+  do j=2,nlseg
+    mygs_lstart(j)=mygs_lstart(j-1)+mygs_len(j-1)
+  enddo
+
+
+!! 
+!! this loop is optimized for the case that the indices in iglobal()
+!! are in the same order that they appear in the global segments,
+!! which seems usually (always?) to be the case. 
+!!
+!! note that the j loop exit condition is only executed when the index
+!! is not found in the current segment, which saves a factor of 2
+!! since many consecutive indices are in the same segment.
+!! 
+
+
+  j=1
+  do i=1,nindex
+
+    i_local(i)= -1
+
+    startj=j
+    SEARCH_LOOP: do
+
+      if ( (mygs_lb(j) <= i_global(i)) .and. &
+           (i_global(i) <= mygs_ub(j))) then
+        i_local(i) = mygs_lstart(j) + (i_global(i) - mygs_lb(j))
+        EXIT SEARCH_LOOP
+      else
+        j=j+1
+        if (j > nlseg) j=1                      ! wrap around
+        if (j == startj) EXIT SEARCH_LOOP
+      endif
+
+    end do SEARCH_LOOP
+
+  end do
+
+!!!! this version vectorizes (outer loop)
+!!!! performance for in-order input is slightly slower than the above
+!!!! but performance on out-of-order input is probably much better
+!!!! at the moment we are going on the assumption that caller is
+!!!! likely providing in-order, so we won't use this version.
+!!
+!!  do i=1,nindex
+!!
+!!    i_local(i)= -1
+!!
+!!    SEARCH_LOOP: do j=1,nlseg
+!!
+!!      if ( (mygs_lb(j) <= i_global(i)) .and. &
+!!           (i_global(i) <= mygs_ub(j))) then
+!!        i_local(i) = mygs_lstart(j) + (i_global(i) - mygs_lb(j))
+!!      endif
+!!
+!!    end do SEARCH_LOOP
+!!
+!!  end do
+
+
+  deallocate( mygs_lb, mygs_ub, mygs_len, mygs_lstart )
+
+ end subroutine GlobalSegMapToIndexArr_
+
+
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalMapToIndex_ - Global to Local Index Translation
+!
+! !DESCRIPTION:  
+! This {\tt INTEGER} query function takes as its input a user-supplied
+! {\tt GlobalMap} data type {\tt GMap}, which desribes a decomposition 
+! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} 
+! handle {\tt comm}, and the input global index value {\tt i\_g}, and 
+! returns a positive local index value if the datum {\tt i\_g}.   If 
+! the datum {\tt i\_g} is not stored on the local process ID, a value 
+! of {\tt -1} is returned.
+!
+! !INTERFACE:
+
+
+ integer function GlobalMapToIndex_(GMap, i_g, comm)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die,          only : MP_perr_die, die, warn
+      use m_GlobalMap,    only : GlobalMap
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalMap), intent(in)  :: GMap  ! Input GlobalMap
+      integer,         intent(in)  :: i_g   ! global index
+      integer,         intent(in)  :: comm  ! communicator handle
+
+! !REVISION HISTORY:
+!  2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalMapToIndex_'
+
+  integer :: myID
+  integer :: count, ierr, ngseg, nlseg, n
+  integer :: lower_bound, upper_bound
+  integer :: local_start, local_index
+  logical :: found
+
+  ! Determine local process id myID:
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK()',ierr)
+
+  ! Initialize logical "point located" flag found as false
+
+  found = .false.
+
+  lower_bound = GMap%displs(myID) + 1
+  upper_bound = GMap%displs(myID) + GMap%counts(myID) 
+
+  if((lower_bound <= i_g) .and. (i_g <= upper_bound)) then
+     found = .true.
+     local_index = i_g - lower_bound + 1
+  endif
+
+  if(found) then
+     GlobalMapToIndex_ = local_index
+  else
+     GlobalMapToIndex_ = -1
+  endif
+
+ end function GlobalMapToIndex_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToNavigator_ - Return Navigator to Local Segments
+!
+! !DESCRIPTION:  
+! This routine takes as its input takes a user-supplied
+! {\tt GlobalSegMap} data type {\tt GSMap}, which desribes a decomposition 
+! on the input MPI communicator corresponding to the Fortran {\tt INTEGER} 
+! handle {\tt comm}, and returns the local segment start index and length 
+! information for referencing the on-pe storage of the mapped distributed
+! data.  These data are returned in the form of the output {\tt Navigator} 
+! argument {Nav}.
+!
+! {\bf N.B.:}  This routine returns a {\tt Navigator} variable {\tt Nav},
+! which must be deallocated once the user no longer needs it.  Failure to 
+! do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine GlobalSegMapToNavigator_(GSMap, comm, oNav)
+
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die,          only : MP_perr_die, die, warn
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_ngseg => ngseg
+      use m_GlobalSegMap, only : GlobalSegMap_nlseg => nlseg
+      use m_Navigator, only    : Navigator
+      use m_Navigator, only    : Navigator_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)  :: GSMap ! Input GlobalSegMap
+      integer,            intent(in)  :: comm  ! communicator handle
+
+! !OUTPUT PARAMETERS:
+
+      type(Navigator),    intent(out) :: oNav   ! Output Navigator
+
+! !REVISION HISTORY:
+!  2Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToNavigator_'
+
+  integer :: myID, ierr, ngseg, nlseg, n, count
+ 
+          ! determine local process id myID
+
+  call MP_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) call MP_perr_die(myname_,'MP_COMM_RANK',ierr)
+
+          ! determine number of global segments ngseg:
+
+  ngseg = GlobalSegMap_ngseg(GSMap)
+
+          ! determine number of local segments on process myID nlseg:
+
+  nlseg = GlobalSegMap_nlseg(GSMap, myID)
+
+          ! Allocate space for the Navigator oNav:
+
+  call Navigator_init(oNav, nlseg, ierr)
+  if(ierr /= 0) call die(myname_,'Navigator_init',ierr)
+
+  call GlobalSegMapToIndices_(GSMap, comm, oNav%displs, oNav%counts)
+
+ end subroutine GlobalSegMapToNavigator_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GlobalSegMapToLocalMatrix_ - Set Local SparseMatrix Indices
+!
+! !DESCRIPTION:  
+! This routine takes as its input a user-supplied {\tt GlobalSegMap} 
+! domain decomposition {\tt GSMap}, which describes the decomposition of 
+! either the rows or columns of the input/output {\tt SparseMatrix} 
+! argument {\tt sMat} on the communicator associated with the {\tt INTEGER}
+! handle {\tt comm}, and to translate the global row or column indices 
+! of {\tt sMat} into their local counterparts.  The choice of either row
+! or column is governed by the value of the input {\tt CHARACTER} 
+! argument {\tt RCFlag}.  One sets this variable to either {\tt 'ROW'} or 
+! {\tt 'row'} to specify row re-indexing (which are stored in
+! {\tt sMat} and retrieved by indexing the attribute {\tt lrow}), and 
+! {\tt 'COLUMN'} or {\tt 'column'} to specify column re-indexing (which 
+! are stored in {\tt sMat} and retrieved by indexing the {\tt SparseMatrix} 
+! attribute {\tt lcol}).
+!
+! !INTERFACE:
+
+ subroutine GlobalSegMapToLocalMatrix_(sMat, GSMap, RCFlag, comm)
+
+!
+! !USES:
+!
+      use m_stdio
+      use m_die,          only : die
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_indexIA => indexIA
+      use m_SparseMatrix, only : SparseMatrix_lsize => lsize
+
+      use m_GlobalSegMap, only : GlobalSegMap
+
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap), intent(in)    :: GSMap  ! Input GlobalSegMap
+      character(len=*),   intent(in)    :: RCFlag ! 'row' or 'column'
+      integer,            intent(in)    :: comm   ! communicator handle
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(SparseMatrix), intent(inout) :: sMat
+
+! !SEE ALSO:
+! The MCT module m_SparseMatrix for more information about the 
+! SparseMatrix type and its storage of global and local row-and
+! column indices.
+!
+! !REVISION HISTORY:
+!  3May01 - J.W. Larson <larson@mcs.anl.gov> - initial version, which
+!           is _extremely_ slow, but safe.  This must be re-examined
+!           later.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GlobalSegMapToLocalMatrix_'
+
+
+  integer :: i, GlobalIndex, gindex, lindex, lsize
+
+   integer, allocatable :: temp_gindex(:)  !! rml
+   integer, allocatable :: temp_lindex(:)  !! rml
+
+
+       ! What are we re-indexing, rows or columns?
+
+  select case(RCFlag)
+  case('ROW','row')
+     gindex = SparseMatrix_indexIA(sMat, 'grow', dieWith=myname_)
+     lindex = SparseMatrix_indexIA(sMat,'lrow', dieWith=myname_)
+  case('COLUMN','column')
+     gindex = SparseMatrix_indexIA(sMat,'gcol', dieWith=myname_)
+     lindex = SparseMatrix_indexIA(sMat,'lcol', dieWith=myname_)
+  case default
+     write(stderr,'(3a)') myname_,":: unrecognized value of RCFLag ",RCFlag
+     call die(myname)
+  end select
+
+
+       ! How many matrix elements are there?
+
+  lsize = SparseMatrix_lsize(sMat)
+
+
+  !! rml new code from here down - do the mapping all in one
+  !! function call which has been tuned for speed
+
+  allocate( temp_gindex(lsize) )
+  allocate( temp_lindex(lsize) )
+
+
+  do i=1,lsize
+     temp_gindex(i) = sMat%data%iAttr(gindex,i)
+  end do
+
+  call GlobalSegMapToIndexArr_(GSMap, temp_gindex, temp_lindex, lsize, comm)  
+
+  do i=1,lsize
+    sMat%data%iAttr(lindex,i) = temp_lindex(i)
+  end do
+
+
+  deallocate(temp_gindex)  ! rml
+  deallocate(temp_lindex)  ! rml
+
+
+ end subroutine	GlobalSegMapToLocalMatrix_
+
+ end module m_GlobalToLocal
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MCTWorld.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MCTWorld.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MCTWorld.F90	(revision 4775)
@@ -0,0 +1,840 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_MCTWorld.F90,v 1.26 2007/06/01 19:56:25 rloy Exp
+! CVS MCT_2_4_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_MCTWorld -- MCTWorld Class
+!
+! !DESCRIPTION:
+! MCTWorld is a datatype which acts as a component model registry.
+! All models communicating through MCT must participate in initialization
+! of MCTWorld.  The single instance of MCTWorld, {\tt ThisMCTWorld} stores
+! the component id and local and global processor rank of each component.
+! This module contains methods for creating and destroying {\tt ThisMCTWorld}
+! as well as inquiry functions.
+!
+! !INTERFACE:
+
+ module m_MCTWorld
+!
+! !USES:
+      use m_List, only : List   ! Support for List components.
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC TYPES:
+
+      public :: MCTWorld        ! The MCTWorld  class data structure
+
+    type MCTWorld
+      integer :: MCT_comm                          ! MCT communicator
+      integer :: ncomps	                           ! Total number of components
+      integer :: mygrank                           ! Rank of this processor in 
+                                                   ! global communicator.
+      integer,dimension(:),pointer :: nprocspid	   ! Number of processes 
+                                                   ! each component is on (e.g. rank of its
+						   ! local communicator.
+      integer,dimension(:,:),pointer :: idGprocid  ! Translate between local component rank
+                                                   ! rank in global communicator.
+						   ! idGprocid(modelid,localrank)=globalrank
+    end type MCTWorld
+
+! !PUBLIC DATA MEMBERS:
+
+    type(MCTWorld) :: ThisMCTWorld   !  declare the MCTWorld
+
+! !PUBLIC MEMBER FUNCTIONS:
+      public :: initialized          ! Determine if MCT is initialized
+      public :: init                 ! Create a MCTWorld
+      public :: clean                ! Destroy a MCTWorld
+      public :: NumComponents        ! Number of Components in the MCTWorld
+      public :: ComponentNumProcs    ! Number of processes owned by a given
+                                     ! component
+      public :: ComponentToWorldRank ! Given the rank of a process on a 
+                                     ! component, return its rank on the 
+                                     ! world communicator
+      public :: ComponentRootRank    ! Return the rank on the world 
+                                     ! communicator of the root process of 
+                                     ! a component
+      public :: ThisMCTWorld         ! Instantiation of the MCTWorld
+
+!  
+
+    interface initialized ; module procedure &
+      initialized_
+    end interface
+    interface init ; module procedure &
+      initd_, &
+      initm_, &
+      initr_
+    end interface
+    interface clean ; module procedure clean_ ; end interface
+    interface NumComponents ; module procedure &
+       NumComponents_ 
+    end interface
+    interface ComponentNumProcs ; module procedure &
+       ComponentNumProcs_ 
+    end interface
+    interface ComponentToWorldRank ; module procedure &
+       ComponentToWorldRank_ 
+    end interface
+    interface ComponentRootRank ; module procedure &
+       ComponentRootRank_ 
+    end interface
+
+
+
+! !REVISION HISTORY:
+! 19Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 05Feb01 - J. Larson <larson@mcs.anl.gov> - added query and
+!           local-to-global mapping services NumComponents, 
+!           ComponentNumProcs, ComponentToWorldRank, and ComponentRootRank
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> - add mylrank and mygrank
+!           to datatype
+! 20Apr01 - R. Jacob <jacob@mcs.anl.gov> - remove allids from
+!           MCTWorld datatype.  Not needed because component
+!           ids are always from 1 to number-of-components.
+! 07Jun01 - R. Jacob <jacob@mcs.anl.gov> - remove myid, mynprocs
+!           and mylrank from MCTWorld datatype because they are not 
+!           clearly defined in PCM mode.  Add MCT_comm for future use.
+! 03Aug01 - E. Ong <eong@mcs.anl.gov> - explicity specify starting
+!           address in mpi_irecv
+! 27Nov01 - E. Ong <eong@mcs.anl.gov> - added R. Jacob's version of initd_
+!           to support PCM mode. 
+! 15Feb02 - R. Jacob - elminate use of MP_COMM_WORLD.  Use
+!           argument globalcomm instead.  Create MCT_comm from
+!           globalcomm
+!EOP __________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_MCTWorld'
+
+ contains
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initialized_ - determine if MCTWorld is initialized
+!
+! !DESCRIPTION:
+! This routine may be used to determine whether {\tt MCTWorld::init} 
+! has been called.  If not, the user must call {\tt init} before
+! performing any other MCT library calls.
+!
+! !INTERFACE:
+
+ logical function initialized_()
+
+!
+! !USES:
+!
+
+! !INPUT PARAMETERS:
+
+
+! !REVISION HISTORY:
+! 01June07 - R. Loy <rloy@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+!
+
+  initialized_ = associated(ThisMCTWorld%nprocspid)
+
+  end function initialized_
+
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initm_ - initialize MCTWorld
+!
+! !DESCRIPTION:
+! Do a distributed init of MCTWorld for the case where a set of processors
+! contains more then one model and the models may not span the set of processors.
+! {\tt ncomps} is the total number of components in the entire coupled system.
+! {\tt globalcomm} encompasses all the models (typically this can be MPI\_COMM\_WORLD).
+! {\tt mycomms} is an array of MPI communicators, each sized for the appropriate model
+! and {\tt myids} is a corresponding array of integers containing the model ids for 
+! the models on this particular set of processors.
+!
+! This routine is called once for the models covered by the set of processors.
+!
+! !INTERFACE:
+
+ subroutine initm_(ncomps,globalcomm,mycomms,myids)
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, intent(in)	       :: ncomps          ! number of components
+      integer, intent(in)	       :: globalcomm      ! global communicator
+      integer, dimension(:),pointer    :: mycomms         ! my communicators
+      integer, dimension(:),pointer    :: myids           ! component ids
+
+! !REVISION HISTORY:
+! 20Sep07 - T. Craig migrated code from initd routine
+! 20Sep07 - T. Craig - made mycomms an array
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initm_'
+  integer :: ier,myGid,myLid,i,mysize,Gsize,j
+
+! arrays allocated on the root to coordinate gathring of data
+! and non-blocking receives by the root
+  integer, dimension(:), allocatable :: compids,reqs,nprocs,Gprocids
+  integer, dimension(:), allocatable :: root_nprocs
+  integer, dimension(:,:),allocatable :: status,root_idGprocid
+  integer, dimension(:,:),pointer :: tmparray
+  integer,dimension(:),pointer :: apoint
+! ------------------------------------------------------------------
+
+! Check that ncomps is a legal value
+  if(ncomps < 1) then
+     call die(myname_, "argument ncomps can't less than one!",ncomps)
+  endif
+
+  if (size(myids) /= size(mycomms)) then
+     call die(myname_, "size of myids and mycomms inconsistent")
+  endif
+
+! make sure this has not been called already
+  if(associated(ThisMCTWorld%nprocspid) ) then
+     write(stderr,'(2a)') myname_, &
+      'MCTERROR:  MCTWorld has already been initialized...Continuing'
+       RETURN
+  endif
+
+! determine overall size
+  call MP_comm_size(globalcomm,Gsize,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+
+! determine my rank in comm_world
+  call MP_comm_rank(globalcomm,myGid,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+! allocate space on global root to receive info about 
+! the other components
+  if(myGid == 0) then
+     allocate(nprocs(ncomps),compids(ncomps),&
+     reqs(ncomps),status(MP_STATUS_SIZE,ncomps),&
+     root_nprocs(ncomps),stat=ier)
+     if (ier /= 0) then
+        call die(myname_, 'allocate(nprocs,...)',ier)
+     endif
+  endif
+
+
+!!!!!!!!!!!!!!!!!!
+!  Gather the number of procs from the root of each component
+!!!!!!!!!!!!!!!!!!
+!
+!  First on the global root, post a receive for each component
+  if(myGid == 0) then
+    do i=1,ncomps
+       call MPI_IRECV(root_nprocs(i), 1, MP_INTEGER, MP_ANY_SOURCE,i, &
+	 globalcomm, reqs(i), ier)
+       if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV(root_nprocs)',ier)
+    enddo
+  endif
+
+!  The local root on each component sends
+  do i=1,size(myids)
+    if(mycomms(i)/=MP_COMM_NULL) then
+      call MP_comm_size(mycomms(i),mysize,ier)
+      if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+      call MP_comm_rank(mycomms(i),myLid,ier)
+      if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+      if(myLid == 0) then
+        call MPI_SEND(mysize,1,MP_INTEGER,0,myids(i),globalcomm,ier)
+        if(ier /= 0) call MP_perr_die(myname_,'MPI_SEND(mysize)',ier)
+      endif
+    endif
+  enddo
+
+!  Global root waits for all sends
+  if(myGid == 0) then
+    call MPI_WAITALL(size(reqs), reqs, status, ier)
+    if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL()',ier)
+  endif
+! Global root now knows how many processors each component is using
+
+!!!!!!!!!!!!!!!!!!
+! end of nprocs
+!!!!!!!!!!!!!!!!!!
+
+
+! allocate a tmp array for the receive on root.
+  if(myGid == 0) then
+    allocate(tmparray(0:Gsize-1,ncomps),stat=ier)
+    if(ier/=0) call die(myname_,'allocate(tmparray)',ier)
+
+! fill tmparray with a bad rank value for later error checking
+    tmparray = -1
+  endif
+
+!!!!!!!!!!!!!!!!!!
+!  Gather the Gprocids from each local root
+!!!!!!!!!!!!!!!!!!
+!
+!  First on the global root, post a receive for each component
+  if(myGid == 0) then
+    do i=1,ncomps
+       apoint => tmparray(0:Gsize-1,i)
+       call MPI_IRECV(apoint(1), root_nprocs(i),MP_INTEGER, &
+       MP_ANY_SOURCE,i,globalcomm, reqs(i), ier)
+       if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV()',ier)
+    enddo
+  endif
+
+!  The root on each component sends
+  do i=1,size(myids)
+    if(mycomms(i)/=MP_COMM_NULL) then
+      call MP_comm_size(mycomms(i),mysize,ier)
+      if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+      call MP_comm_rank(mycomms(i),myLid,ier)
+      if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+! make the master list of global proc ids
+!
+! allocate space to hold global ids
+! only needed on root, but allocate everywhere to avoid complaints.
+      allocate(Gprocids(mysize),stat=ier)
+      if(ier/=0) call die(myname_,'allocate(Gprocids)',ier)
+! gather over the LOCAL comm
+      call MPI_GATHER(myGid,1,MP_INTEGER,Gprocids,1,MP_INTEGER,0,mycomms(i),ier)
+      if(ier/=0) call die(myname_,'MPI_GATHER Gprocids',ier)
+
+      if(myLid == 0) then
+        call MPI_SEND(Gprocids,mysize,MP_INTEGER,0,myids(i),globalcomm,ier)
+        if(ier /= 0) call MP_perr_die(myname_,'MPI_SEND(Gprocids)',ier)
+      endif
+
+      deallocate(Gprocids,stat=ier)
+      if(ier/=0) call die(myname_,'deallocate(Gprocids)',ier)
+    endif
+  enddo
+
+!  Global root waits for all sends
+  if(myGid == 0) then
+    call MPI_WAITALL(size(reqs), reqs, status, ier)
+    if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(Gprocids)',ier)
+  endif
+
+!  Now store the Gprocids in the World description and Broadcast
+
+  if(myGid == 0) then
+    allocate(root_idGprocid(ncomps,0:Gsize-1),stat=ier)
+    if(ier/=0) call die(myname_,'allocate(root_idGprocid)',ier)
+
+    root_idGprocid = transpose(tmparray)
+  endif
+
+  if(myGid /= 0) then
+     allocate(root_nprocs(1),root_idGprocid(1,1),stat=ier)
+     if(ier/=0) call die(myname_,'non-root allocate(root_idGprocid)',ier)
+  endif
+
+!!!!!!!!!!!!!!!!!!
+! end of Gprocids
+!!!!!!!!!!!!!!!!!!
+
+! now call the init from root.
+  call initr_(ncomps,globalcomm,root_nprocs,root_idGprocid)
+
+! if(myGid==0 .or. myGid==17) then
+!   write(*,*)'MCTA',myGid,ThisMCTWorld%ncomps,ThisMCTWorld%MCT_comm,ThisMCTWorld%nprocspid
+!   do i=1,ThisMCTWorld%ncomps
+!     write(*,*)'MCTK',myGid,i,ThisMCTWorld%idGprocid(i,0:ThisMCTWorld%nprocspid(i)-1)
+!   enddo
+! endif
+
+! deallocate temporary arrays
+ deallocate(root_nprocs,root_idGprocid,stat=ier)
+ if(ier/=0) call die(myname_,'deallocate(root_nprocs,..)',ier)
+ if(myGid == 0) then
+   deallocate(compids,reqs,status,nprocs,tmparray,stat=ier)
+   if(ier/=0) call die(myname_,'deallocate(compids,..)',ier)
+ endif
+
+ end subroutine initm_
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initd_ - initialize MCTWorld
+!
+! !DESCRIPTION:
+! Do a distributed init of MCTWorld using the total number of components 
+! {\tt ncomps} and either a unique integer component id {\tt myid} or,
+! if more than one model is placed on a processor, an array of integer ids 
+! specifying the models {\tt myids}.  Also required is
+! the local communicator {\tt mycomm} and global communicator {\tt globalcomm}
+! which encompasses all the models (typically this can be MPI\_COMM\_WORLD).
+! This routine must be called once by each component (using {\em myid}) or
+! component group (using {\em myids}).
+!
+! !INTERFACE:
+
+ subroutine initd_(ncomps,globalcomm,mycomm,myid,myids)
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, intent(in)	       :: ncomps          ! number of components
+      integer, intent(in)	       :: globalcomm      ! global communicator
+      integer, intent(in)	       :: mycomm          ! my communicator
+      integer, intent(in),optional     :: myid            ! my component id
+      integer, dimension(:),pointer,optional  :: myids    ! component ids
+
+! !REVISION HISTORY:
+! 19Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 07Feb01 - R. Jacob <jacob@mcs.anl.gov> - non fatal error
+!           if init is called a second time.
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> - initialize the new
+!           mygrank and mylrank
+! 20Apr01 - R. Jacob <jacob@mcs.anl.gov> - remove allids from
+!           MCTWorld datatype.  Not needed because component
+!           ids are always from 1 to number-of-components.
+! 22Jun01 - R. Jacob <jacob@mcs.anl.gov> - move Bcast and init
+!           of MCTWorld to initr_
+! 20Sep07 - T. Craig migrated code to new initm routine
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initd_'
+  integer :: msize,ier
+  integer, dimension(:), pointer :: mycomm1d,myids1d
+
+! ------------------------------------------------------------------
+
+
+! only one of myid and myids should be present
+  if(present(myid) .and. present(myids)) then
+    write(stderr,'(2a)') myname_, &
+      'MCTERROR:  Must define myid or myids in MCTWord init'
+      call die(myname_)
+  endif
+
+  if(.not.present(myid) .and. .not.present(myids)) then
+    write(stderr,'(2a)') myname_, &
+      'MCTERROR:  Must define one of myid or myids in MCTWord init'
+      call die(myname_)
+  endif
+
+  if (present(myids)) then
+     msize = size(myids)
+  else
+     msize = 1
+  endif
+
+  allocate(mycomm1d(msize),myids1d(msize),stat=ier)
+  if(ier/=0) call die(myname_,'non-root allocate(root_idGprocid)',ier)
+  mycomm1d(:) = mycomm
+
+  if (present(myids)) then
+     myids1d(:) = myids(:)
+  else
+     myids1d(:) = myid
+  endif
+
+  call initm_(ncomps,globalcomm,mycomm1d,myids1d)
+
+  deallocate(mycomm1d,myids1d)
+
+ end subroutine initd_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initr_ - initialize MCTWorld from global root
+!
+! !DESCRIPTION:
+! Initialize MCTWorld using information valid only on the global root.
+! This is called by initm\_ but could also be called by the user
+! for very complex model--processor geometries.
+!
+! !INTERFACE:
+
+ subroutine initr_(ncomps,globalcomm,rnprocspid,ridGprocid)
+!
+! !USES:
+!
+      use m_mpif90
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer, intent(in)                :: ncomps     ! total number of components
+      integer, intent(in)                :: globalcomm ! the global communicator
+      integer, dimension(:),intent(in)   :: rnprocspid ! number of processors for each component
+      integer, dimension(:,:),intent(in) :: ridGprocid ! an array of size (1:ncomps) x (0:Gsize-1) 
+						       ! which maps local ranks to global ranks
+                                                       ! it's actually 1:Gsize here
+
+! !REVISION HISTORY:
+! 22Jun01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initr_'
+  integer :: ier,Gsize,myGid,MCTcomm,i,j
+
+! Check that ncomps is a legal value
+  if(ncomps < 1) then
+     call die(myname_, "argument ncomps can't less than one!",ncomps)
+  endif
+
+! determine overall size
+  call MP_comm_size(globalcomm,Gsize,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_size()',ier)
+
+! determine my rank in comm_world
+  call MP_comm_rank(globalcomm,myGid,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_rank()',ier)
+
+! create the MCT comm world
+  call MP_comm_dup(globalcomm,MCTcomm,ier)
+  if(ier /= 0) call MP_perr_die(myname_,'MP_comm_dup()',ier)
+
+  allocate(ThisMCTWorld%nprocspid(ncomps),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(MCTWorld%nprocspid(:),...',ier)
+  allocate(ThisMCTWorld%idGprocid(ncomps,0:Gsize-1),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(MCTWorld%nprocspid(:),...',ier)
+
+!  set the MCTWorld
+  ThisMCTWorld%ncomps = ncomps
+  ThisMCTWorld%MCT_comm = MCTcomm
+  ThisMCTWorld%mygrank = myGid
+
+! Now store the component ids in the World description and Broadcast
+  if(myGid == 0) then
+    ThisMCTWorld%nprocspid(1:ncomps) = rnprocspid(1:ncomps)
+    ThisMCTWorld%idGprocid = ridGprocid
+  endif
+
+  call MPI_BCAST(ThisMCTWorld%nprocspid, ncomps, MP_INTEGER, 0, MCTcomm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCast nprocspid',ier)
+
+  call MPI_BCAST(ThisMCTWorld%idGprocid, ncomps*Gsize,MP_INTEGER, 0,MCTcomm, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MPI_BCast Gprocids',ier)
+
+! if(myGid==17) then
+!      do i=1,ThisMCTWorld%ncomps
+!       do j=1,ThisMCTWorld%nprocspid(i)
+!     write(*,*)'MCTK',myGid,i,j-1,ThisMCTWorld%idGprocid(i,j-1)
+!    enddo
+!   enddo
+! endif
+
+ end subroutine initr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a MCTWorld
+!
+! !DESCRIPTION:
+! This routine deallocates the arrays of {\tt ThisMCTWorld}
+! It also zeros out the integer components.
+!
+! !INTERFACE:
+
+    subroutine clean_()
+!
+! !USES:
+!
+      use m_die
+
+      implicit none
+
+! !REVISION HISTORY:
+! 19Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> - clean the new
+!           mygrank and mylrank
+! 20Apr01 - R. Jacob <jacob@mcs.anl.gov> - remove allids from
+!           MCTWorld datatype.  Not needed because component
+!           ids are always from 1 to number-of-components.
+! 07Jun01 - R. Jacob <jacob@mcs.anl.gov> - remove myid,mynprocs
+!           and mylrank.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  deallocate(ThisMCTWorld%nprocspid,ThisMCTWorld%idGprocid,stat=ier)
+  if(ier /= 0) call warn(myname_,'deallocate(MCTW,...)',ier)
+
+  ThisMCTWorld%ncomps = 0
+  ThisMCTWorld%mygrank = 0
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: NumComponents_ - Determine number of components in World.
+!
+! !DESCRIPTION:
+! The function {\tt NumComponents\_} takes an input {\tt MCTWorld} 
+! argument {\tt World}, and returns the number of component models 
+! present.
+!
+! !INTERFACE:
+
+ integer function NumComponents_(World)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(MCTWorld), intent(in)      :: World
+
+! !REVISION HISTORY:
+! 05Feb01 - J. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::NumComponents_'
+
+  integer :: ncomps
+
+  ncomps = World%ncomps
+
+  if(ncomps <= 0) then
+     write(stderr,'(2a,1i3)') myname,":: invalid no. of components = ",ncomps
+     call die(myname_,'ncomps = ',ncomps)
+  endif
+
+  NumComponents_ = ncomps
+
+ end function NumComponents_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ComponentNumProcs_ - Number of processes a component owns.
+!
+! !DESCRIPTION:
+! The function {\tt ComponentNumProcs\_} takes an input {\tt MCTWorld} 
+! argument {\tt World}, and a component ID {\tt comp\_id}, and returns 
+! the number of processes owned by that component.
+!
+! !INTERFACE:
+
+ integer function ComponentNumProcs_(World, comp_id)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+      type(MCTWorld), intent(in)      :: World
+      integer,        intent(in)      :: comp_id
+
+! !REVISION HISTORY:
+! 05Feb01 - J. Larson <larson@mcs.anl.gov> - initial version
+! 07Jun01 - R. Jacob <jacob@mcs.anl.gov> - modify to use
+!           nprocspid and comp_id instead of World%mynprocs
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::ComponentNumPros_'
+
+  integer :: mynprocs
+
+  mynprocs = World%nprocspid(comp_id)
+
+  if(mynprocs <= 0) then
+     write(stderr,'(2a,1i6)') myname,":: invalid no. of processes = ",mynprocs
+     call die(myname_,'Number of processes = ',mynprocs)
+  endif
+
+  ComponentNumProcs_ = mynprocs
+
+ end function ComponentNumProcs_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ComponentToWorldRank_ - Determine rank on COMM_WORLD.
+!
+! !DESCRIPTION:
+! The function {\tt ComponentToWorldRank\_} takes an input component ID 
+! {\tt comp\_id} and input rank on that component communicator 
+! {\tt comp\_rank}, and returns the rank of that process on the world 
+! communicator of {\tt MCTWorld}.  
+!
+! !INTERFACE:
+
+ integer function ComponentToWorldRank_(comp_rank, comp_id, World)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      implicit none
+  
+! !INPUT PARAMETERS:
+      integer, intent(in)	     :: comp_rank ! process rank on the communicator
+                                                  ! associated with comp_id
+      integer, intent(in)	     :: comp_id   ! component id
+      type(MCTWorld), intent(in)     :: World     ! World
+
+
+! !REVISION HISTORY:
+!       05Feb01 - J. Larson <larson@mcs.anl.gov> - initial version
+!       14Jul02 - E. Ong <eong@mcs.anl.gov> - made argument checking required
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::ComponentToWorldRank_'
+
+  logical :: valid
+  integer :: n, world_rank
+
+
+      ! Do we want the potentially time-consuming argument checks?
+      ! The first time we use this function during execution on a
+      ! given set of components and component ranks, we will.  In
+      ! later invocations, these argument checks are probably not
+      ! necessary (unless one alters MCTWorld), and impose a cost
+      ! one may wish to avoid.
+
+      ! These checks are just conditional statements and are 
+      ! not particularly time-consuming. It's better to be safe
+      ! than sorry. -EONG
+
+
+      ! Check argument comp_id for validity--assume initially it is not...
+
+  valid = .false.
+  n = 0
+
+  if((comp_id <= World%ncomps) .and. &
+       (comp_id > 0)) then
+     valid = .true.
+  endif
+  
+  if(.not. valid) then
+     write(stderr,'(2a,1i7)') myname,":: invalid component id no. = ",&
+	  comp_id
+     call die(myname_,'invalid comp_id = ',comp_id)
+  endif
+
+      ! Check argument comp_rank for validity on the communicator associated
+      ! with comp_id.  Assume initialy it is invalid.
+
+  valid = .false.
+  
+  if((0 <= comp_rank) .or. &
+       (comp_rank < ComponentNumProcs_(World, comp_id))) then
+     valid = .true.
+  endif
+
+  if(.not. valid) then
+     write(stderr,'(2a,1i5,1a,1i2)') myname, &
+	  ":: invalid process ID. = ", &
+	  comp_rank, "on component ",comp_id
+     call die(myname_,'invalid comp_rank = ',comp_rank)
+  endif
+
+
+      ! If we have reached this point, the input data are valid.
+      ! Return the global rank for comp_rank on component comp_id
+
+  world_rank = World%idGprocid(comp_id, comp_rank)
+
+  if(world_rank < 0) then
+     write(stderr,'(2a,1i6)') myname,":: negative world rank = ",world_rank
+     call die(myname_,'negative world rank = ',world_rank)
+  endif    
+
+  ComponentToWorldRank_ = world_rank
+
+ end function ComponentToWorldRank_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ComponentRootRank_ - Rank of component root on COMM_WORLD.
+!
+! !DESCRIPTION:
+! The function {\tt ComponentRootRank\_} takes an input component ID 
+! {\tt comp\_id} and input {\tt MCTWorld} variable {\tt World}, and
+! returns the global rank of the root of this component.  
+!
+! !INTERFACE:
+
+ integer function ComponentRootRank_(comp_id, World)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT PARAMETERS:
+      integer, intent(in)	     :: comp_id   ! component id
+      type(MCTWorld), intent(in)     :: World     ! World
+
+! !REVISION HISTORY:
+!       05Feb01 - J. Larson <larson@mcs.anl.gov> - initial version
+!       14Jul02 - E. Ong <eong@mcs.anl.gov> - made argument checking required
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::ComponentRootRank_'
+
+  integer :: world_comp_root
+
+      ! Call ComponentToWorldRank_ assuming the root on a remote component
+      ! has rank zero on the communicator associated with that component.
+
+  world_comp_root = ComponentToWorldRank_(0, comp_id, World)
+
+  if(world_comp_root < 0) then
+     write(stderr,'(2a,1i6)') myname,":: negative world rank = ",& 
+	  world_comp_root
+     call die(myname_,'invalid root id = ',world_comp_root)
+  endif    
+
+  ComponentRootRank_ = world_comp_root
+
+ end function ComponentRootRank_
+
+ end module m_MCTWorld
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MatAttrVectMul.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MatAttrVectMul.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_MatAttrVectMul.F90	(revision 4775)
@@ -0,0 +1,632 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math + Computer Science Division / Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_MatAttrVectMul.F90,v 1.30 2008-01-11 22:54:04 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_MatAttrVectMul - Sparse Matrix AttrVect Multipication.
+!
+! !DESCRIPTION:
+!
+! This module contains routines supporting the sparse matrix-vector 
+! multiplication
+! $${\bf y} = {\bf M} {\bf x},$$
+! where the vectors {\bf x} and {\bf y} are stored using the MCT 
+! {\tt AttrVect} datatype, and {\bf M} is stored using either the MCT 
+! {\tt SparseMatrix} or {\tt SparseMatrixPlus} type.  The {\tt SparseMatrix} 
+! type is used to represent {\bf M} if the multiplication process is 
+! purely data-local (e.g., in a global address space, or if the process
+! has been rendered embarrasingly parallel by earlier or subsequent 
+! vector data redistributions).  If the multiplication process is to 
+! be explicitly distributed-memory parallel, then the {\tt SparseMatrixPlus}
+! type is used to store the elements of {\bf M} and all information needed
+! to coordinate data redistribution and reduction of partial sums.
+!
+! {\bf N.B.:} The matrix-vector multiplication routines in this module 
+! process only the {\bf real} attributes of the {\tt AttrVect} arguments
+! corresponding to {\bf x} and {\bf y}.  They ignore the integer attributes.
+!
+! !INTERFACE:
+
+ module m_MatAttrVectMul
+
+      private   ! except
+
+      public :: sMatAvMult        ! The master Sparse Matrix -
+                                  ! Attribute Vector multipy API
+
+    interface sMatAvMult   ; module procedure &
+        sMatAvMult_DataLocal_, &
+        sMatAvMult_sMPlus_
+    end interface
+
+! !SEE ALSO:
+! The MCT module m_AttrVect for more information about the AttrVect type.
+! The MCT module m_SparseMatrix for more information about the SparseMatrix 
+! type.
+! The MCT module m_SparseMatrixPlus for more details about the master class 
+! for parallel sparse matrix-vector multiplication, the SparseMatrixPlus.
+
+! !REVISION HISTORY:
+! 12Jan01 - J.W. Larson <larson@mcs.anl.gov> - initial module.
+! 26Sep02 - J.W. Larson <larson@mcs.anl.gov> - added high-level, distributed
+!           matrix-vector multiply routine using the SparseMatrixPlus class.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_MatAttrVectMul'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math + Computer Science Division / Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: sMatAvMult_DataLocal -- Purely local matrix-vector multiply
+!
+! !DESCRIPTION:
+!
+! The sparse matrix-vector multiplication routine {\tt sMatAvMult\_DataLocal\_()} 
+! operates on the assumption of total data locality, which is equivalent 
+! to the following two conditions:
+! \begin{enumerate}
+! \item The input {\tt AttrVect} {\tt xAV} contains all the values referenced 
+! by the local column indices stored in the input {\tt SparsMatrix} argument 
+! {\tt sMat}; and
+! \item The output {\tt AttrVect} {\tt yAV} contains all the values referenced 
+! by the local row indices stored in the input {\tt SparsMatrix} argument 
+! {\tt sMat}.
+! \end{enumerate}
+! By default, the multiplication occurs for each of the common {\tt REAL} attributes 
+! shared by {\tt xAV} and {\tt yAV}.  This routine is capable of 
+! cross-indexing the attributes and performing the necessary multiplications.
+!
+! If the optional argument {\tt rList} is present, only the attributes listed will
+! be multiplied.  If the attributes have different names in {\tt yAV}, the optional
+! {\tt TrList} argument can be used to provide the translation.
+! 
+! If the optional argument {\tt Vector} is present and true, the vector
+! architecture-friendly portions of this routine will be invoked.  It
+! will also cause the vector parts of {\\ sMat} to be initialized if they
+! have not been already.
+!
+! !INTERFACE:
+
+ subroutine sMatAvMult_DataLocal_(xAV, sMat, yAV, Vector, rList, TrList)
+!
+! !USES:
+!
+      use m_realkinds, only : FP 
+      use m_stdio,     only : stderr
+      use m_die,       only : MP_perr_die, die, warn
+
+      use m_List, only : List_identical => identical
+      use m_List, only : List_nitem => nitem
+      use m_List, only : GetIndices => get_indices
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+      use m_AttrVect, only : SharedAttrIndexList
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_lsize => lsize
+      use m_SparseMatrix, only : SparseMatrix_indexIA => indexIA
+      use m_SparseMatrix, only : SparseMatrix_indexRA => indexRA
+      use m_SparseMatrix, only : SparseMatrix_vecinit => vecinit
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(in)    :: xAV
+      logical,optional,   intent(in)    :: Vector
+      character(len=*),optional, intent(in)    :: rList
+      character(len=*),optional, intent(in)    :: TrList
+
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(SparseMatrix), intent(inout)    :: sMat
+      type(AttrVect),     intent(inout) :: yAV
+
+! !REVISION HISTORY:
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 10Feb01 - J.W. Larson <larson@mcs.anl.gov> - Prototype code.
+! 24Apr01 - J.W. Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix datatype.
+! 25Apr01 - J.W. Larson <larson@mcs.anl.gov> - Reversed loop order
+!           for cache-friendliness
+! 17May01 - R. Jacob <jacob@mcs.anl.gov> - Zero the output
+!           attribute vector
+! 10Oct01 - J. Larson <larson@mcs.anl.gov> - Added optional LOGICAL
+!           input argument InterpInts to make application of the
+!           multiply to INTEGER attributes optional
+! 15Oct01 - J. Larson <larson@mcs.anl.gov> - Added feature to 
+!           detect when attribute lists are identical, and cross-
+!           indexing of attributes is not needed.
+! 29Nov01 - E.T. Ong <eong@mcs.anl.gov> - Removed MP_PERR_DIE if
+!           there are zero elements in sMat. This allows for
+!           decompositions where a process may own zero points.
+! 29Oct03 - R. Jacob <jacob@mcs.anl.gov> - add Vector argument to
+!           optionally use the vector-friendly version provided by
+!           Fujitsu
+! 21Nov06 - R. Jacob <jacob@mcs.anl.gov> - Allow attributes to be
+!           to be multiplied to be specified with rList and TrList.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::sMatAvMult_DataLocal_'
+
+! Matrix element count:
+  integer :: num_elements
+
+! Matrix row, column, and weight indices:
+  integer :: icol, irow, iwgt
+
+! Overlapping attribute index number
+  integer :: num_indices
+
+! Overlapping attribute index storage arrays:
+  integer, dimension(:), pointer :: xAVindices, yAVindices
+
+! Temporary variables for multiply do-loop
+  integer :: row, col
+  real(FP) :: wgt
+
+! Error flag and loop indices
+  integer :: ierr, i, m, n, l,ier
+  integer :: inxmin,outxmin
+  integer :: ysize, numav,j
+
+! Character variable used as a data type flag:
+  character*7 :: data_flag
+
+! logical flag
+  logical :: usevector,TrListIsPresent,rListIsPresent
+  logical :: contiguous,ycontiguous
+
+  usevector = .false.
+  if(present(Vector)) then
+    if(Vector) usevector = .true.
+  endif
+
+  rListIsPresent = .false.
+  if(present(rList)) then
+    rListIsPresent = .true.
+  endif
+
+!  TrList is present if it is provided and its length>0
+  TrListIsPresent = .false.
+  if(present(TrList)) then
+     if(.not.present(rList)) then
+       call die(myname_,'MCTERROR: TrList provided without rList',2)
+     endif
+     if(len_trim(TrList) > 0) then
+       TrListIsPresent = .true.
+     endif
+  endif
+
+
+       ! Retrieve the number of elements in sMat:
+
+  num_elements = SparseMatrix_lsize(sMat)
+
+       ! Indexing the sparse matrix sMat:
+
+  irow = SparseMatrix_indexIA(sMat,'lrow')    ! local row index
+  icol = SparseMatrix_indexIA(sMat,'lcol')    ! local column index
+  iwgt = SparseMatrix_indexRA(sMat,'weight')  ! weight index
+
+
+       ! Multiplication sMat by REAL attributes in xAV:
+
+  if(List_identical(xAV%rList, yAV%rList).and.   &
+    .not.rListIsPresent) then                  ! no cross-indexing
+
+       ! zero the output AttributeVector
+     call AttrVect_zero(yAV, zeroInts=.FALSE.)
+
+     num_indices = List_nitem(xAV%rList)
+
+     if(usevector) then
+
+       if(.not.sMat%vecinit) then
+            call SparseMatrix_vecinit(sMat)
+       endif
+
+!DIR$ CONCURRENT
+       do m=1,num_indices
+          do l=1,sMat%tbl_end
+!CDIR NOLOOPCHG
+!DIR$ CONCURRENT
+             do i=sMat%row_s(l),sMat%row_e(l)
+               col = sMat%tcol(i,l)
+               wgt = sMat%twgt(i,l)
+               if (col < 0) cycle
+               yAV%rAttr(m,i) = yAV%rAttr(m,i) + wgt * xAV%rAttr(m,col)
+             enddo
+          enddo
+       enddo
+ 
+     else
+
+       do n=1,num_elements
+
+    	  row = sMat%data%iAttr(irow,n)
+    	  col = sMat%data%iAttr(icol,n)
+	  wgt = sMat%data%rAttr(iwgt,n)
+
+         ! loop over attributes being regridded.
+
+!DIR$ CONCURRENT
+	  do m=1,num_indices
+
+	     yAV%rAttr(m,row) = yAV%rAttr(m,row) + wgt * xAV%rAttr(m,col)
+
+  	  end do ! m=1,num_indices
+
+       end do ! n=1,num_elements
+
+     endif
+
+! lists are not identical or only want to do part.
+  else
+
+   if(rListIsPresent) then
+     call GetIndices(xAVindices,xAV%rList,trim(rList))
+
+     if(TrListIsPresent) then
+       call GetIndices(yAVindices,yAV%rList,trim(TrList))
+
+       if(size(xAVindices) /= size(yAVindices)) then
+         call die(myname_,"Arguments rList and TrList do not& 
+             &contain the same number of items") 
+       endif   
+
+     else
+       call GetIndices(yAVindices,yAV%rList,trim(rList))
+     endif
+
+     num_indices=size(yAVindices)
+
+     ! nothing to do if num_indices <=0
+     if (num_indices <= 0) then 
+       deallocate(xaVindices, yAVindices, stat=ier)
+       if(ier/=0) call die(myname_,"deallocate(xAVindices...)",ier)
+       return  
+     endif
+
+   else
+
+     data_flag = 'REAL'
+     call SharedAttrIndexList(xAV, yAV, data_flag, num_indices, &
+	                      xAVindices, yAVindices)
+
+     ! nothing to do if num_indices <=0
+     if (num_indices <= 0) then
+       deallocate(xaVindices, yAVindices, stat=ier)
+       call warn(myname_,"No matching indicies found, returning.")
+       if(ier/=0) call die(myname_,"deallocate(xaVinindices...)",ier)
+       return
+     endif
+   endif
+
+! Check if the indices are contiguous in memory for faster copy
+   contiguous=.true.
+   ycontiguous=.true.
+   do i=2,num_indices
+      if(xaVindices(i) /= xAVindices(i-1)+1) contiguous = .false. 
+   enddo
+   if(contiguous) then
+      do i=2,num_indices
+          if(yAVindices(i) /= yAVindices(i-1)+1) then
+	    contiguous=.false.
+            ycontiguous=.false.
+          endif
+      enddo   
+   endif
+
+       ! zero the right parts of the output AttributeVector
+   ysize = AttrVect_lsize(yAV)
+   numav=size(yAVindices)
+
+   if(ycontiguous) then
+     outxmin=yaVindices(1)-1
+     do j=1,ysize
+       do i=1,numav
+         yAV%rAttr(outxmin+i,j)=0._FP
+       enddo
+     enddo
+   else
+     do j=1,ysize
+       do i=1,numav
+         yAV%rAttr(yaVindices(i),j)=0._FP
+       enddo
+     enddo
+   endif
+
+       ! loop over matrix elements
+
+   if(contiguous) then
+     outxmin=yaVindices(1)-1
+     inxmin=xaVindices(1)-1
+     do n=1,num_elements
+
+	row = sMat%data%iAttr(irow,n)
+	col = sMat%data%iAttr(icol,n)
+	wgt = sMat%data%rAttr(iwgt,n)
+
+       ! loop over attributes being regridded.
+!DIR$ CONCURRENT
+  	do m=1,num_indices
+	    yAV%rAttr(outxmin+m,row) = &
+	       yAV%rAttr(outxmin+m,row) + &
+	       wgt * xAV%rAttr(inxmin+m,col)
+        end do ! m=1,num_indices
+     end do ! n=1,num_elements
+
+   else
+     do n=1,num_elements
+
+	row = sMat%data%iAttr(irow,n)
+	col = sMat%data%iAttr(icol,n)
+	wgt = sMat%data%rAttr(iwgt,n)
+
+       ! loop over attributes being regridded.
+!DIR$ CONCURRENT
+  	do m=1,num_indices
+	    yAV%rAttr(yAVindices(m),row) = &
+	       yAV%rAttr(yAVindices(m),row) + &
+	       wgt * xAV%rAttr(xAVindices(m),col)
+        end do ! m=1,num_indices
+     end do ! n=1,num_elements
+   endif
+
+
+   deallocate(xAVindices, yAVindices, stat=ierr)
+   if(ierr /= 0) call die(myname_,'first deallocate(xAVindices...',ierr)
+
+  endif ! if(List_identical(xAV%rAttr, yAV%rAttr))...
+        ! And we are finished!
+
+ end subroutine sMatAvMult_DataLocal_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!     Math + Computer Science Division / Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: sMatAvMult_SMPlus_ - Parallel Multiply Using SparseMatrixPlus
+!
+! !DESCRIPTION:
+! This routine performs distributed parallel sparse matrix-vector 
+! multiplication ${\bf y} = {\bf M} {\bf x}$, where {\bf y} and
+! {\bf x} are represented by the {\tt AttrVect} arguments {\tt yAV} and
+! {\tt xAV}, respectively.  The matrix {\bf M} is stored in the input 
+! {\tt SparseMatrixPlus} argument {\tt sMatPlus}, which also contains 
+! all the information needed to coordinate the communications required to 
+! gather intermediate vectors used in the multiplication process, and to 
+! reduce partial sums as needed.
+! By default, the multiplication occurs for each of the common {\tt REAL} attributes 
+! shared by {\tt xAV} and {\tt yAV}.  This routine is capable of 
+! cross-indexing the attributes and performing the necessary multiplications.
+!
+! If the optional argument {\tt rList} is present, only the attributes listed will
+! be multiplied.  If the attributes have different names in {\tt yAV}, the optional
+! {\tt TrList} argument can be used to provide the translation.
+! 
+! If the optional argument {\tt Vector} is present and true, the vector
+! architecture-friendly portions of this routine will be invoked.  It
+! will also cause the vector parts of {\tt sMatPlus} to be initialized if they
+! have not been already.
+!
+! !INTERFACE:
+
+ subroutine sMatAvMult_SMPlus_(xAV, sMatPlus, yAV, Vector, rList, TrList)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_String, only : String
+      use m_String, only : String_ToChar => ToChar
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_Rcopy => Rcopy
+      use m_AttrVect, only : AttrVect_zero  => zero
+
+      use m_Rearranger, only : Rearranger
+      use m_Rearranger, only : Rearrange
+
+      use m_SparseMatrixPlus, only : SparseMatrixPlus
+      use m_SparseMatrixPlus, only : Xonly
+      use m_SparseMatrixPlus, only : Yonly
+      use m_SparseMatrixPlus, only : XandY
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),         intent(in)    :: xAV
+      logical, optional,      intent(in)    :: Vector
+      character(len=*),optional, intent(in)    :: rList
+      character(len=*),optional, intent(in)    :: TrList
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(AttrVect),         intent(inout) :: yAV
+      type(SparseMatrixPlus), intent(inout) :: sMatPlus
+
+! !SEE ALSO:
+! The MCT module m_AttrVect for more information about the AttrVect type.
+! The MCT module m_SparseMatrixPlus for more information about the 
+! SparseMatrixPlus type.
+
+! !REVISION HISTORY:
+! 26Sep02 - J.W. Larson <larson@mcs.anl.gov> - API specification and
+!           implementation.
+! 29Oct03 - R. Jacob <jacob@mcs.anl.gov> - add vector argument to all
+!           calls to Rearrange and DataLocal_.  Add optional input
+!           argument to change value (assumed false)
+! 22Nov06 - R. Jacob <jacob@mcs.anl.gov> - add rList,TrList arguments
+! 10Jan08 - T. Craig <tcraig@ucar.edu> - zero out intermediate aVs before
+!           they are used
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::sMatAvMult_SMPlus_'
+  type(AttrVect) :: xPrimeAV, yPrimeAV
+  type(AttrVect) :: yAVre
+  integer :: ierr
+  logical ::  usevector
+  character(len=5) :: strat
+
+  ! check arguments
+  if(present(TrList)) then
+     if(.not.present(rList)) then
+       call die(myname_,'MCTERROR: TrList provided without rList',2)
+     endif
+  endif
+
+  usevector = .FALSE.
+  if(present(Vector)) then
+   if(Vector)usevector = .TRUE.
+  endif
+       ! Examine the parallelization strategy, and act accordingly
+
+  strat = String_ToChar(sMatPlus%Strategy)
+  select case( strat )
+  case('Xonly')
+       ! Create intermediate AttrVect for x'
+     call AttrVect_init(xPrimeAV, xAV, sMatPlus%XPrimeLength)
+     call AttrVect_zero(xPrimeAV)
+       ! Rearrange data from x to get x'
+     call Rearrange(xAV, xPrimeAV, sMatPlus%XToXPrime, &
+                    sMatPlus%Tag ,vector=usevector)
+
+       ! Perform perfectly data-local multiply y = Mx'
+     if (present(TrList).and.present(rList)) then
+       call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yaV, &
+              Vector=usevector,rList=rList,TrList=TrList)
+     else if(.not.present(TrList) .and. present(rList)) then
+       call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yaV, &
+               Vector=usevector,rList=rList)
+     else
+       call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yaV, &
+               Vector=usevector)
+     endif
+
+       ! Clean up space occupied by x'
+     call AttrVect_clean(xPrimeAV, ierr)
+  case('Yonly')
+       ! Create intermediate AttrVect for y'
+     if (present(TrList).and.present(rList)) then
+        call AttrVect_init(yPrimeAV, rList=TrList, lsize=sMatPlus%YPrimeLength)
+     else if(.not.present(TrList) .and. present(rList)) then
+        call AttrVect_init(yPrimeAV, rList=rList, lsize=sMatPlus%YPrimeLength)
+     else
+        call AttrVect_init(yPrimeAV, yAV, sMatPlus%YPrimeLength)
+     endif
+     call AttrVect_zero(yPrimeAV)
+
+     if (present(TrList).or.present(rList)) then
+        call AttrVect_init(yAVre, yPrimeAV , lsize=AttrVect_lsize(yAV))
+        call AttrVect_zero(yAVre)
+     endif
+
+       ! Perform perfectly data-local multiply y' = Mx
+     if (present(TrList).and.present(rList)) then
+        call sMatAvMult_DataLocal_(xAV, sMatPlus%Matrix, yPrimeAV, &
+	       Vector=usevector,rList=rList,TrList=TrList)
+     else if(.not.present(TrList) .and. present(rList)) then
+        call sMatAvMult_DataLocal_(xAV, sMatPlus%Matrix, yPrimeAV, &
+	       Vector=usevector,rList=rList)
+     else
+        call sMatAvMult_DataLocal_(xAV, sMatPlus%Matrix, yPrimeAV, &
+	       Vector=usevector)
+     endif
+     
+       ! Rearrange/reduce partial sums in y' to get y
+     if (present(TrList).or.present(rList)) then
+       call Rearrange(yPrimeAV, yAVre, sMatPlus%YPrimeToY, sMatPlus%Tag, &
+                    .TRUE., Vector=usevector)
+       call AttrVect_Rcopy(yAVre,yAV,vector=usevector)
+       call AttrVect_clean(yAVre, ierr)
+     else
+       call Rearrange(yPrimeAV, yAV, sMatPlus%YPrimeToY, sMatPlus%Tag, &
+                    .TRUE., Vector=usevector)
+     endif
+       ! Clean up space occupied by y'
+     call AttrVect_clean(yPrimeAV, ierr)
+
+  case('XandY')
+       ! Create intermediate AttrVect for x'
+     call AttrVect_init(xPrimeAV, xAV, sMatPlus%XPrimeLength)
+     call AttrVect_zero(xPrimeAV)
+
+       ! Create intermediate AttrVect for y'
+     if (present(TrList).and.present(rList)) then
+        call AttrVect_init(yPrimeAV, rList=TrList, lsize=sMatPlus%YPrimeLength)
+     else if(.not.present(TrList) .and. present(rList)) then
+        call AttrVect_init(yPrimeAV, rList=rList, lsize=sMatPlus%YPrimeLength)
+     else
+        call AttrVect_init(yPrimeAV, yAV, sMatPlus%YPrimeLength)
+     endif
+     call AttrVect_zero(yPrimeAV)
+
+     if (present(TrList).or.present(rList)) then
+        call AttrVect_init(yAVre, yPrimeAV , lsize=AttrVect_lsize(yAV))
+        call AttrVect_zero(yAVre)
+     endif
+
+       ! Rearrange data from x to get x'
+     call Rearrange(xAV, xPrimeAV, sMatPlus%XToXPrime, sMatPlus%Tag, &
+                       Vector=usevector)
+
+       ! Perform perfectly data-local multiply y' = Mx'
+     if (present(TrList).and.present(rList)) then
+         call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yPrimeAV, &
+                             Vector=usevector,rList=rList,TrList=TrList)
+     else if(.not.present(TrList) .and. present(rList)) then
+         call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yPrimeAV, &
+                             Vector=usevector,rList=rList)
+     else
+         call sMatAvMult_DataLocal_(xPrimeAV, sMatPlus%Matrix, yPrimeAV, &
+                             Vector=usevector)
+     endif
+
+       ! Rearrange/reduce partial sums in y' to get y
+     if (present(TrList).or.present(rList)) then
+       call Rearrange(yPrimeAV, yAVre, sMatPlus%YPrimeToY, sMatPlus%Tag, &
+                    .TRUE., Vector=usevector)
+       call AttrVect_Rcopy(yAVre,yAV,vector=usevector)
+       call AttrVect_clean(yAVre, ierr)
+     else
+       call Rearrange(yPrimeAV, yAV, sMatPlus%YPrimeToY, sMatPlus%Tag, &
+                    .TRUE., Vector=usevector)
+     endif
+
+       ! Clean up space occupied by x'
+     call AttrVect_clean(xPrimeAV, ierr)
+       ! Clean up space occupied by y'
+     call AttrVect_clean(yPrimeAV, ierr)
+  case default
+     write(stderr,'(4a)') myname_, &
+	  ':: FATAL ERROR--parallelization strategy name ',&
+	  String_ToChar(sMatPlus%Strategy),' not supported.'
+     call die(myname_)
+  end select
+
+ end subroutine sMatAvMult_SMPlus_
+
+ end module m_MatAttrVectMul
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Merge.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Merge.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Merge.F90	(revision 4775)
@@ -0,0 +1,2912 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Merge.F90,v 1.9 2005-11-30 02:58:13 larson Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Merge - Merge flux and state data from multiple sources.
+!
+! !DESCRIPTION:  This module supports {\em merging} of state and flux
+! data from multiple components with overlapping spatial domains for use 
+! by another component.  For example, let the vectors ${\bf a}$ and 
+! ${\bf b}$ be data from Components $A$ and $B$ that have been 
+! interpolated onto the physical grid of another component $C$.  We wish
+! to combine the data from $A$ and $B$ to get a vector ${\bf c}$, which
+! represents the merged data on the grid of component $C$.  This merge 
+! process is an element-by-element masked weighted average:
+! $$ c_i = {{{{\prod_{j=1}^J} M_{i}^j} {{\prod_{k=1}^K} F_{i}^k} a_i + 
+! {{\prod_{p=1}^P} N_{i}^p} {{\prod_{q=1}^Q} G_{i}^q} b_i} \over
+! {{{\prod_{j=1}^J} M_{i}^j} {{\prod_{k=1}^K} F_{i}^k} + 
+! {{\prod_{p=1}^P} N_{i}^p} {{\prod_{q=1}^Q} G_{i}^q}}}, $$
+! Where ${M_{i}^j}$ and ${N_{i}^p}$ are {\em integer masks} (which have 
+! value either $0$ or $1$), and ${F_{i}^k}$ and ${G_{i}^q}$ are {\em real 
+! masks} (which are in the closed interval $[0,1]$).
+!
+! Currently, we assume that the integer and real masks are stored in 
+! the same {\tt GeneralGrid} datatype.  We also assume--and this is of 
+! critical importance to the user--that the attributes to be merged are 
+! the same for all the inputs and output.  If the user violates this 
+! assumption, incorrect merges will occur for any attributes that are 
+! present in only some (that is not all) of the inputs.
+!
+! This module supports explicitly the merging data from two, three, and 
+! four components.  There is also a routine named {\tt MergeInData} that 
+! allows the user to construct other merging schemes.
+!
+! !INTERFACE:
+
+ module m_Merge
+
+!
+! !USES:
+!
+!     No other modules used in the declaration section of this module.
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC TYPES:
+
+!     None.
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: MergeTwo      ! Merge Output from two components
+                              ! for use by a third.
+      public :: MergeThree    ! Merge Output from three components
+                              ! for use by a fourth.
+      public :: MergeFour     ! Merge Output from four components
+                              ! for use by a fifth.
+      public :: MergeInData   ! Merge in data from a single component.
+
+    interface MergeTwo ; module procedure &
+         MergeTwoGGSP_, &
+         MergeTwoGGDP_
+    end interface
+    interface MergeThree ; module procedure &
+         MergeThreeGGSP_, &
+	 MergeThreeGGDP_
+    end interface
+    interface MergeFour ; module procedure &
+         MergeFourGGSP_, &
+         MergeFourGGDP_
+    end interface
+    interface MergeInData ; module procedure &
+         MergeInDataGGSP_, &
+         MergeInDataGGDP_
+    end interface
+
+! !PUBLIC DATA MEMBERS:
+
+!     None.
+
+! !REVISION HISTORY:
+!       19Jun02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Merge'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MergeTwoGGSP_ - Merge Data from Two Sources
+!
+! !DESCRIPTION:  This routine merges {\tt REAL} attribute data from 
+! two input {\tt AttrVect} arguments {\tt inAv1} and {\tt inAv2} to 
+! a third {\tt AttrVect} {\tt outAv}.  The attributes to be merged are 
+! determined entirely by the real attributes of {\tt outAv}.  If 
+! {\tt outAv} shares one or more attributes with either of the inputs 
+! {\tt inAv1} or {\tt inAv2}, a merge is performed on the individual 
+! {\em intersections} of attributes between the pairs $({\tt outAv},
+! {\tt inAv1})$ and $({\tt outAv},{\tt inAv1})$.  Currently, it is assumed
+! that these pairwise intersections are all equal.  This assumption is of 
+! critical importance to the user.  If the user violates this 
+! assumption, incorrect merges of attributes that are present in some 
+! (but not all) of the inputs will result.
+!
+! The merge operatrion is a masked 
+! weighted element-by-element sum, as outlined in the following example.  
+! Let the vectors ${\bf a}$ and ${\bf b}$ be data from Components $A$ 
+! and $B$ that have been interpolated onto the physical grid of another 
+! component $C$.  We wish to combine the data from $A$ and $B$ to get 
+! a vector ${\bf c}$, which represents the merged data on the grid of 
+! component $C$.  The merge relation to obtain the $i$th element of 
+! {\bf c} is 
+! $$ c_i = {1 \over {W_i}} \bigg\{ {{\prod_{j=1}^J} \kappa_{i}^j} 
+! {{\prod_{k=1}^K} \alpha_{i}^k} {a_i} + {{\prod_{l=1}^L} \lambda_{i}^l} 
+! {{\prod_{m=1}^M} \beta_{i}^m} {b_i} \bigg\} , $$
+! where
+! $$ {W_i} = {{\prod_{j=1}^J} \kappa_{i}^j} {{\prod_{k=1}^K} \alpha_{i}^k} + 
+! {{\prod_{l=1}^L} \lambda_{i}^l} {{\prod_{m=1}^M} \beta_{i}^m}. $$
+! The quantities ${\kappa_{i}^j}$ and ${\lambda_{i}^l}$ are {\em integer
+! masks} (which have value either $0$ or $1$), and ${\alpha_{i}^k}$ and 
+! ${\beta_{i}^m}$ are {\em real masks} (which are in the closed interval 
+! $[0,1]$).
+!
+! The integer and real masks are stored as attributes to the same input 
+! {\tt GeneralGrid} argument {\tt GGrid}.  The mask attribute names are 
+! stored as substrings to the colon-separated strings contained in the 
+! input {\tt CHARACTER} arguments {\tt iMaskTags1}, {\tt iMaskTags2}, 
+! {\tt rMaskTags1}, and {\tt rMaskTags2}.  The {\tt LOGICAL} input 
+! argument {\tt CheckMasks} governs how the masks are applied.  If 
+! ${\tt CheckMasks} = {\tt .TRUE.}$, the entries are checked to ensure 
+! they meet the definitions of real and integer masks.  If 
+! ${\tt CheckMasks} = {\tt .TRUE.}$ then the masks are multiplied 
+! together on an element-by-element basis with no validation of their 
+! entries (this option results in slightly higher performance).
+!
+! This routine returns the sume of the masked weights as a diagnostic.
+! This quantity is returned in the output {\tt REAL} array {\tt WeightSum}.
+!
+! The correspondence between the quantities in the above merge relation 
+! and the arguments to this routine are summarized in the table.
+! \begin{center}
+! \begin{tabular}{|l|l|l|}\hline
+! {\bf Quantity} & {\bf Stored in} & {\bf Referenced by}  \\
+!  & {\bf Argument}    & {\bf Argument} \\
+! \hline
+! \hline 
+! $ {a_i} $ & {\tt inAv1} & \\
+! \hline
+! $ {b_i} $ & {\tt inAv2} & \\
+! \hline
+! $ {c_i} $ & {\tt outAv} & \\
+! \hline
+! $ {\kappa_i^j}, j=1,\ldots,J $ & {\tt GGrid} & {\tt iMaskTags1}\\
+! & & ($J$ items) \\
+! \hline
+! $ {\alpha_i^k}, k=1,\ldots,K $ & {\tt GGrid} & {\tt rMaskTags1}\\
+! & & ($K$ items) \\
+! \hline
+! $ {\lambda_i^l}, l=1,\ldots,L $ & {\tt GGrid} & {\tt iMaskTags2}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\beta_i^m}, m=1,\ldots,M $ & {\tt GGrid} & {\tt rMaskTags2}\\
+! & & ($M$ items) \\
+! \hline
+! $ {W_i} $ & {\tt WeightSum} & \\
+! \hline
+! \end{tabular}
+! \end{center}
+!
+! !INTERFACE:
+
+ subroutine MergeTwoGGSP_(inAv1, iMaskTags1, rMaskTags1, &
+                        inAv2, iMaskTags2, rMaskTags2, &
+                        GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : SP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(SP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeTwoGGSP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGSP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGSP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeTwoGGSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+!
+! !IROUTINE: MergeTwoGGDP_ - merge data from two components.
+!
+! !DESCRIPTION:
+! Double precision version of MergeTwoGGSP_
+!
+! !INTERFACE:
+
+ subroutine MergeTwoGGDP_(inAv1, iMaskTags1, rMaskTags1, &
+                        inAv2, iMaskTags2, rMaskTags2, &
+                        GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : DP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(DP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!_______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeTwoGGDP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGDP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGDP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeTwoGGDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MergeThreeGGSP_ - Merge Data from Three Sources
+!
+! !DESCRIPTION:  This routine merges {\tt REAL} attribute data from 
+! three input {\tt AttrVect} arguments {\tt inAv1} , {\tt inAv2}, and 
+! {\tt inAv3} to a fourth {\tt AttrVect} {\tt outAv}.  The attributes to 
+! be merged are determined entirely by the real attributes of {\tt outAv}.
+!   If {\tt outAv} shares one or more attributes with any of the inputs 
+! {\tt inAv1}, {\tt inAv2}, or {\tt inAv3}, a merge is performed on the 
+! individual {\em intersections} of attributes between the pairs 
+! $({\tt outAv},{\tt inAv1})$,  $({\tt outAv},{\tt inAv2})$, 
+! and $({\tt outAv},{\tt inAv3})$.  Currently, it is assumed that these 
+! pairwise intersections are all equal.  This assumption is of 
+! critical importance to the user.  If the user violates this 
+! assumption, incorrect merges of any attributes present only in some 
+! (but not all) inputs will result.
+!
+! The merge operatrion is a masked 
+! weighted element-by-element sum, as outlined in the following example.  
+! Let the vectors ${\bf a}$,${\bf b}$, and ${\bf c}$ be data from 
+! Components $A$, $B$, and $C$ that have been interpolated onto the 
+! physical grid of another component $D$.  We wish to combine the data 
+! from $A$, $B$ and $C$ to get a vector ${\bf d}$, which represents the 
+! merged data on the grid of component $D$.  The merge relation to obtain 
+! the $i$th element of ${\bf d}$ is 
+! $$ d_i = {1 \over {W_i}} \bigg\{ {{\prod_{j=1}^J} \kappa_{i}^j} 
+! {{\prod_{k=1}^K} \alpha_{i}^k} {a_i} + {{\prod_{l=1}^L} \lambda_{i}^l} 
+! {{\prod_{m=1}^M} \beta_{i}^m} {b_i} + {{\prod_{p=1}^P} \mu_{i}^p} 
+! {{\prod_{q=1}^Q} \gamma_{i}^q} {c_i} \bigg\} , $$
+! where
+! $$ {W_i} = {{\prod_{j=1}^J} \kappa_{i}^j} {{\prod_{k=1}^K} \alpha_{i}^k} + 
+! {{\prod_{l=1}^L} \lambda_{i}^l} {{\prod_{m=1}^M} \beta_{i}^m} + 
+! {{\prod_{p=1}^P} \mu_{i}^p} {{\prod_{q=1}^Q} \gamma_{i}^q}. $$
+! The quantities ${\kappa_{i}^j}$, ${\lambda_{i}^p}$, and ${\mu_{i}^p}$ are 
+! {\em integer masks} (which have value either $0$ or $1$), and 
+! ${\alpha_{i}^k}$, ${\beta_{i}^m}$, and ${\gamma_{i}^q}$ are {\em real 
+! masks} (which are in the closed interval $[0,1]$).
+!
+! The integer and real masks are stored as attributes to the same input 
+! {\tt GeneralGrid} argument {\tt GGrid}.  The mask attribute names are 
+! stored as substrings to the colon-separated strings contained in the 
+! input {\tt CHARACTER} arguments {\tt iMaskTags1}, {\tt iMaskTags2}, 
+! {\tt iMaskTags3}, {\tt rMaskTags1}, {\tt rMaskTags2}, and 
+! {\tt rMaskTags3}.  The {\tt LOGICAL} input argument {\tt CheckMasks} 
+! governs how the masks are applied.  If ${\tt CheckMasks} = {\tt .TRUE.}$, 
+! the entries are checked to ensure they meet the definitions of real 
+! and integer masks.  If ${\tt CheckMasks} = {\tt .FALSE.}$ then the masks 
+! are multiplied together on an element-by-element basis with no validation 
+! of their entries (this option results in slightly higher performance).  
+!
+! This routine returns the sum of the masked weights as a diagnostic.
+! This quantity is returned in the output {\tt REAL} array {\tt WeightSum}.
+!
+! The correspondence between the quantities in the above merge relation 
+! and the arguments to this routine are summarized in the table.
+! \begin{center}
+! \begin{tabular}{|l|l|l|}\hline
+! {\bf Quantity} & {\bf Stored in} & {\bf Referenced by}  \\
+!  & {\bf Argument}    & {\bf Argument} \\
+! \hline
+! \hline 
+! $ {a_i} $ & {\tt inAv1} & \\
+! \hline
+! $ {b_i} $ & {\tt inAv2} & \\
+! \hline
+! $ {c_i} $ & {\tt inAv3} & \\
+! \hline
+! $ {d_i} $ & {\tt outAv} & \\
+! \hline
+! $ {\kappa_i^j}, j=1,\ldots,J $ & {\tt GGrid} & {\tt iMaskTags1}\\
+! & & ($J$ items) \\
+! \hline
+! $ {\alpha_i^k}, k=1,\ldots,K $ & {\tt GGrid} & {\tt rMaskTags1}\\
+! & & ($K$ items) \\
+! \hline
+! $ {\lambda_i^l}, l=1,\ldots,L $ & {\tt GGrid} & {\tt iMaskTags2}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\beta_i^m}, m=1,\ldots,M $ & {\tt GGrid} & {\tt rMaskTags2}\\
+! & & ($M$ items) \\
+! \hline
+! $ {\mu_i^p}, p=1,\ldots,P $ & {\tt GGrid} & {\tt iMaskTags3}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\gamma_i^q}, q=1,\ldots,Q $ & {\tt GGrid} & {\tt rMaskTags3}\\
+! & & ($M$ items) \\
+! \hline
+! $ {W_i} $ & {\tt WeightSum} & \\
+! \hline
+! \end{tabular}
+! \end{center}
+!
+! !INTERFACE:
+
+ subroutine MergeThreeGGSP_(inAv1, iMaskTags1, rMaskTags1, &
+                            inAv2, iMaskTags2, rMaskTags2, &
+                            inAv3, iMaskTags3, rMaskTags3, &
+                            GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : SP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(AttrVect),               intent(IN)    :: inAv3
+      character(len=*),   optional, intent(IN)    :: iMaskTags3
+      character(len=*),   optional, intent(IN)    :: rMaskTags3
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(SP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeThreeGGSP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv3%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv3 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2) .or. present(iMaskTags3)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2) .or. present(rMaskTags3)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv3) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv3 and outAv must match.', &
+	  'AttrVect_lsize(inAv3) = ',AttrVect_lsize(inAv3), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGSP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGSP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Third input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags3 and
+       ! rMaskTags3.
+
+  if(present(iMaskTags3)) then
+
+     if(present(rMaskTags3)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv3, iMaskTags3, rMaskTags3, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv3, iMaskTags=iMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags3)) then ! only real masks
+	call MergeInDataGGSP_(inAv3, rMaskTags=rMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags3))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeThreeGGSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+!
+! !IROUTINE: MergeThreeGGDP_ - merge data from three components.
+!
+! !DESCRIPTION:
+! Double precision version of MergeThreeGGSP_
+!
+! !INTERFACE:
+
+ subroutine MergeThreeGGDP_(inAv1, iMaskTags1, rMaskTags1, &
+                            inAv2, iMaskTags2, rMaskTags2, &
+                            inAv3, iMaskTags3, rMaskTags3, &
+                            GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : DP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(AttrVect),               intent(IN)    :: inAv3
+      character(len=*),   optional, intent(IN)    :: iMaskTags3
+      character(len=*),   optional, intent(IN)    :: rMaskTags3
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(DP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!_______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeThreeGGDP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv3%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv3 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2) .or. present(iMaskTags3)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2) .or. present(rMaskTags3)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv3) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv3 and outAv must match.', &
+	  'AttrVect_lsize(inAv3) = ',AttrVect_lsize(inAv3), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGDP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGDP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Third input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags3 and
+       ! rMaskTags3.
+
+  if(present(iMaskTags3)) then
+
+     if(present(rMaskTags3)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv3, iMaskTags3, rMaskTags3, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv3, iMaskTags=iMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags3)) then ! only real masks
+	call MergeInDataGGDP_(inAv3, rMaskTags=rMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags3))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeThreeGGDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MergeFourGGSP_ - Merge Data from Four Sources
+!
+! !DESCRIPTION:  This routine merges {\tt REAL} attribute data from 
+! four input {\tt AttrVect} arguments {\tt inAv1} , {\tt inAv2}, 
+! {\tt inAv3}, and {\tt inAv4} to a fifth {\tt AttrVect} {\tt outAv}.  The 
+! attributes to be merged are determined entirely by the real attributes 
+! of {\tt outAv}.  If {\tt outAv} shares one or more attributes with any of 
+! the inputs {\tt inAv1}, {\tt inAv2}, {\tt inAv3}, or {\tt inAv4}, a merge 
+! is performed on the individual {\em intersections} of attributes between 
+! the pairs $({\tt outAv},{\tt inAv1})$,  $({\tt outAv},{\tt inAv2})$, 
+! $({\tt outAv},{\tt inAv3})$, and $({\tt outAv},{\tt inAv3})$.  Currently, 
+! it is assumed that these pairwise intersections are all equal.  This 
+! assumption is of critical importance to the user.  If the user violates 
+! this assumption, incorrect merges of any attributes present only in some
+! (but not all) the inputs will result.
+!
+! The merge operatrion is a masked 
+! weighted element-by-element sum, as outlined in the following example.  
+! Let the vectors ${\bf a}$,${\bf b}$, ${\bf c}$ and ${\bf d}$ be data from 
+! Components $A$, $B$, $C$, and $D$ that have been interpolated onto the 
+! physical grid of another component $E$.  We wish to combine the data 
+! from $A$, $B$, $C$, and $D$ to get a vector ${\bf e}$, which represents the 
+! merged data on the grid of component $E$.  The merge relation to obtain 
+! the $i$th element of {\bf e} is 
+! $$ e_i = {1 \over {W_i}} \bigg\{ {{\prod_{j=1}^J} \kappa_{i}^j} 
+! {{\prod_{k=1}^K} \alpha_{i}^k} {a_i} + {{\prod_{l=1}^L} \lambda_{i}^l} 
+! {{\prod_{m=1}^M} \beta_{i}^m} {b_i} + {{\prod_{p=1}^P} \mu_{i}^p} 
+! {{\prod_{q=1}^Q} \gamma_{i}^q} {c_i} +  
+! {{\prod_{r=1}^R} \nu_{i}^r} {{\prod_{s=1}^S} \delta_{i}^s} {d_i} \bigg\} , $$
+! where
+! $$ {W_i} = {{\prod_{j=1}^J} \kappa_{i}^j} {{\prod_{k=1}^K} \alpha_{i}^k} + 
+! {{\prod_{l=1}^L} \lambda_{i}^l} {{\prod_{m=1}^M} \beta_{i}^m} + 
+! {{\prod_{p=1}^P} \mu_{i}^p} {{\prod_{q=1}^Q} \gamma_{i}^q} + 
+! {{\prod_{r=1}^R} \nu_{i}^r} {{\prod_{s=1}^S} \delta_{i}^s}. $$
+! The quantities ${\kappa_{i}^j}$, ${\lambda_{i}^p}$, ${\mu_{i}^p}$, and 
+! ${\nu_{i}^r}$ are {\em integer masks} (which have value either $0$ or $1$), 
+! and ${\alpha_{i}^k}$, ${\beta_{i}^m}$, ${\gamma_{i}^q}$, and ${\delta_{i}^s}$ 
+! are {\em real masks} (which are in the closed interval $[0,1]$).
+!
+! The integer and real masks are stored as attributes to the same input 
+! {\tt GeneralGrid} argument {\tt GGrid}.  The mask attribute names are 
+! stored as substrings to the colon-separated strings contained in the 
+! input {\tt CHARACTER} arguments {\tt iMaskTags1}, {\tt iMaskTags2}, 
+! {\tt iMaskTags3}, {\tt iMaskTags4}, {\tt rMaskTags1}, and {\tt rMaskTags2},
+! {\tt rMaskTags3}, and {\tt rMaskTags4}, .  The {\tt LOGICAL} input 
+! argument {\tt CheckMasks} governs how the masks are applied.    If 
+! ${\tt CheckMasks} = {\tt .TRUE.}$, the entries are checked to ensure 
+! they meet the definitions of real and integer masks.  If ${\tt CheckMasks} 
+! = {\tt .FALSE.}$ then the masks are multiplied together on an 
+! element-by-element basis with no validation of their entries (this option
+! results in slightly higher performance).
+!
+! This routine returns the sume of the masked weights as a diagnostic.
+! This quantity is returned in the output {\tt REAL} array {\tt WeightSum}.
+!
+! The correspondence between the quantities in the above merge relation 
+! and the arguments to this routine are summarized in the table.
+! \begin{center}
+! \begin{tabular}{|l|l|l|}\hline
+! {\bf Quantity} & {\bf Stored in} & {\bf Referenced by}  \\
+!  & {\bf Argument}    & {\bf Argument} \\
+! \hline
+! \hline 
+! $ {a_i} $ & {\tt inAv1} & \\
+! \hline
+! $ {b_i} $ & {\tt inAv2} & \\
+! \hline
+! $ {c_i} $ & {\tt inAv3} & \\
+! \hline
+! $ {d_i} $ & {\tt inAv4} & \\
+! \hline
+! $ {e_i} $ & {\tt outAv} & \\
+! \hline
+! $ {\kappa_i^j}, j=1,\ldots,J $ & {\tt GGrid} & {\tt iMaskTags1}\\
+! & & ($J$ items) \\
+! \hline
+! $ {\alpha_i^k}, k=1,\ldots,K $ & {\tt GGrid} & {\tt rMaskTags1}\\
+! & & ($K$ items) \\
+! \hline
+! $ {\lambda_i^l}, l=1,\ldots,L $ & {\tt GGrid} & {\tt iMaskTags2}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\beta_i^m}, m=1,\ldots,M $ & {\tt GGrid} & {\tt rMaskTags2}\\
+! & & ($M$ items) \\
+! \hline
+! $ {\mu_i^p}, p=1,\ldots,P $ & {\tt GGrid} & {\tt iMaskTags3}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\gamma_i^q}, q=1,\ldots,Q $ & {\tt GGrid} & {\tt rMaskTags3}\\
+! & & ($M$ items) \\
+! \hline
+! $ {\nu_i^r}, r=1,\ldots,R $ & {\tt GGrid} & {\tt iMaskTags4}\\
+! & & ($L$ items) \\
+! \hline
+! $ {\delta_i^s}, s=1,\ldots,S $ & {\tt GGrid} & {\tt rMaskTags4}\\
+! & & ($M$ items) \\
+! \hline
+! $ {W_i} $ & {\tt WeightSum} & \\
+! \hline
+! \end{tabular}
+! \end{center}
+!
+! !INTERFACE:
+
+ subroutine MergeFourGGSP_(inAv1, iMaskTags1, rMaskTags1, &
+                           inAv2, iMaskTags2, rMaskTags2, &
+                           inAv3, iMaskTags3, rMaskTags3, &
+                           inAv4, iMaskTags4, rMaskTags4, &
+                           GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : SP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(AttrVect),               intent(IN)    :: inAv3
+      character(len=*),   optional, intent(IN)    :: iMaskTags3
+      character(len=*),   optional, intent(IN)    :: rMaskTags3
+      type(AttrVect),               intent(IN)    :: inAv4
+      character(len=*),   optional, intent(IN)    :: iMaskTags4
+      character(len=*),   optional, intent(IN)    :: rMaskTags4
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(SP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeFourGGSP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv3%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv3 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv4%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv4 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2) .or. &
+                        present(iMaskTags3) .or. present(iMaskTags4)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2) .or. &
+                        present(rMaskTags3) .or. present(rMaskTags4)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv3) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv3 and outAv must match.', &
+	  'AttrVect_lsize(inAv3) = ',AttrVect_lsize(inAv3), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv4) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv4 and outAv must match.', &
+	  'AttrVect_lsize(inAv4) = ',AttrVect_lsize(inAv4), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGSP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGSP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Third input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags3 and
+       ! rMaskTags3.
+
+  if(present(iMaskTags3)) then
+
+     if(present(rMaskTags3)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv3, iMaskTags3, rMaskTags3, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv3, iMaskTags=iMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags3)) then ! only real masks
+	call MergeInDataGGSP_(inAv3, rMaskTags=rMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags3))...
+
+       ! Fourth input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags4 and
+       ! rMaskTags4.
+
+  if(present(iMaskTags4)) then
+
+     if(present(rMaskTags4)) then ! both real and integer masks
+	call MergeInDataGGSP_(inAv4, iMaskTags4, rMaskTags4, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGSP_(inAv4, iMaskTags=iMaskTags4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags4)) then ! only real masks
+	call MergeInDataGGSP_(inAv4, rMaskTags=rMaskTags4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGSP_(inAv4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags4))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeFourGGSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+!
+! !IROUTINE: MergeFourGGDP_ - merge data from four components.
+!
+! !DESCRIPTION:
+! Double precision versions of MergeFourGGSP_
+!
+! !INTERFACE:
+
+ subroutine MergeFourGGDP_(inAv1, iMaskTags1, rMaskTags1, &
+                           inAv2, iMaskTags2, rMaskTags2, &
+                           inAv3, iMaskTags3, rMaskTags3, &
+                           inAv4, iMaskTags4, rMaskTags4, &
+                           GGrid, CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : DP, FP
+
+      use m_List, only : List
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv1
+      character(len=*),   optional, intent(IN)    :: iMaskTags1
+      character(len=*),   optional, intent(IN)    :: rMaskTags1
+      type(AttrVect),               intent(IN)    :: inAv2
+      character(len=*),   optional, intent(IN)    :: iMaskTags2
+      character(len=*),   optional, intent(IN)    :: rMaskTags2
+      type(AttrVect),               intent(IN)    :: inAv3
+      character(len=*),   optional, intent(IN)    :: iMaskTags3
+      character(len=*),   optional, intent(IN)    :: rMaskTags3
+      type(AttrVect),               intent(IN)    :: inAv4
+      character(len=*),   optional, intent(IN)    :: iMaskTags4
+      character(len=*),   optional, intent(IN)    :: rMaskTags4
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(DP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - Interface spec.
+!        3Jul02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!_______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeFourGGDP_'
+
+  integer :: i, j
+  real(FP) :: invWeightSum
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv1%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv1 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv2%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv2 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv3%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv3 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(inAv4%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv4 has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes!'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags1) .or. present(iMaskTags2) .or. &
+                        present(iMaskTags3) .or. present(iMaskTags4)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags1) .or. present(rMaskTags2) .or. &
+                        present(rMaskTags3) .or. present(rMaskTags4)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes!'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated!'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv1) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv1 and outAv must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv2 and outAv must match.', &
+	  'AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv3) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv3 and outAv must match.', &
+	  'AttrVect_lsize(inAv3) = ',AttrVect_lsize(inAv3), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv4) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv4 and outAv must match.', &
+	  'AttrVect_lsize(inAv4) = ',AttrVect_lsize(inAv4), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and GGrid must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv1) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv1 and WeightSum must match.', &
+	  'AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Initialize the elements of WeightSum(:) to zero:
+
+  do i=1,size(WeightSum)
+     WeightSum(i) = 0._FP
+  end do
+
+       ! Process the incoming data one input AttrVect and mask tag 
+       ! combination at a time.
+
+       ! First input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags1 and
+       ! rMaskTags1.
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags1, rMaskTags1, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv1, iMaskTags=iMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags1)) then ! only real masks
+	call MergeInDataGGDP_(inAv1, rMaskTags=rMaskTags1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv1, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags1))...
+
+       ! Second input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags2 and
+       ! rMaskTags2.
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags2, rMaskTags2, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv2, iMaskTags=iMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags2)) then ! only real masks
+	call MergeInDataGGDP_(inAv2, rMaskTags=rMaskTags2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv2, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Third input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags3 and
+       ! rMaskTags3.
+
+  if(present(iMaskTags3)) then
+
+     if(present(rMaskTags3)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv3, iMaskTags3, rMaskTags3, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv3, iMaskTags=iMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags3)) then ! only real masks
+	call MergeInDataGGDP_(inAv3, rMaskTags=rMaskTags3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv3, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags3))...
+
+       ! Fourth input AttrVect/mask combination...must work through 
+       ! all the possible cases for optional arguments iMaskTags4 and
+       ! rMaskTags4.
+
+  if(present(iMaskTags4)) then
+
+     if(present(rMaskTags4)) then ! both real and integer masks
+	call MergeInDataGGDP_(inAv4, iMaskTags4, rMaskTags4, GGrid, &
+                            CheckMasks, outAv, WeightSum)
+     else ! only integer masks
+	call MergeInDataGGDP_(inAv4, iMaskTags=iMaskTags4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  else
+
+     if(present(rMaskTags4)) then ! only real masks
+	call MergeInDataGGDP_(inAv4, rMaskTags=rMaskTags4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     else ! no masks at all
+	call MergeInDataGGDP_(inAv4, GGrid=GGrid, &
+                            CheckMasks=CheckMasks, outAv=outAv, &
+			    WeightSum=WeightSum)
+     endif
+
+  endif ! if(present(iMaskTags4))...
+
+       ! Now we must renormalize the entries in outAv by dividing 
+       ! element-by-element by the sums of the merge weights, which
+       ! were accumulated in WeightSum(:)
+
+  do i=1,AttrVect_lsize(outAv)
+
+     if(WeightSum(i) /= 0._FP) then
+	invWeightSum = 1._FP / WeightSum(i)
+     else
+	write(stderr,'(2a,i8,a)') myname_,':: FATAL--WeightSum(', &
+	                          i,') is zero!'
+	call die(myname_)
+     endif
+
+     do j=1,AttrVect_nRAttr(outAv)
+	outAv%rAttr(j,i) = invWeightSum * outAv%rAttr(j,i) 
+     end do
+
+  end do
+
+       ! The merge is now complete.
+
+ end subroutine MergeFourGGDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MergeInDataGGSP_ - Add Data into a Merge
+!
+! !DESCRIPTION:  This routine takes input field data from the input 
+! {\tt AttrVect} argument {\tt inAv}, and merges the real attributes it 
+! shares with the input/output {\tt AttrVect} argument {\tt outAv}.  
+! The merge is a masked merge of the form 
+! $$ c_i = c_i + {{\prod_{j=1}^J} M_{i}^j} {{\prod_{k=1}^K} F_{i}^k} 
+! a_i , $$
+! where ${c_i}$ represents one element of one of the real attributes of 
+! {\tt outAv}, and ${a_i}$ represents one element of one of the real 
+! attributes of {\tt inAv}.  The ${M_{i}^j}$ are {\em integer masks} which 
+! have value either $0$ or $1$, and are integer attributes of the input 
+! {\tt GeneralGrid} argument {\tt GGrid}.  The ${F_{i}^k}$ are {\em real 
+! masks} whose values are in the closed interval $[0,1]$, and are real 
+! attributes of the input {\tt GeneralGrid} argument {\tt GGrid}.  The 
+! input {\tt CHARACTER} argument {\tt iMaskTags} is a string of colon-
+! delimited strings that name the integer attributes in {\tt GGrid} 
+! that are used as the masks ${M_{i}^j}$.  The input {\tt CHARACTER} 
+! argument {\tt rMaskTags} is a string of colon-delimited strings 
+! that name the real attributes in {\tt GGrid} that are used as the 
+! masks ${F_{i}^k}$.  The output {\tt REAL} array {\tt WeightSum} is 
+! used to store a running sum of the product of the masks.  The 
+! {\tt LOGICAL} input argument {\tt CheckMasks} governs how the masks 
+! are applied.  If ${\tt CheckMasks} = {\tt .TRUE.}$, the entries are 
+! checked to ensure they meet the definitions of real and integer masks.  
+! If ${\tt CheckMasks} = {\tt .FALSE.}$ then the masks are multiplied 
+! together on an element-by-element basis with no validation of their 
+! entries (this option results in slightly higher performance).
+!
+! {\tt N.B.:}  The lengths of the {\tt AttrVect} arguments {\tt inAv} 
+! and {\tt outAv} must be equal, and this length must also equal the 
+! lengths of {\tt GGrid} and {\tt WeightSum}.
+!
+! {\tt N.B.:}  This algorithm assumes the {\tt AttrVect} argument 
+! {\tt outAv} has been created, and its real attributes have been
+! initialized.
+!
+! {\tt N.B.:}  This algorithm assumes that the array {\tt WeightSum} 
+! has been created and initialized.
+!
+! !INTERFACE:
+
+ subroutine MergeInDataGGSP_(inAv, iMaskTags, rMaskTags, GGrid, &
+                             CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : SP, FP
+
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => toChar
+
+      use m_List, only : List
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_get => get
+      use m_List, only : List_identical => identical
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : SharedAttrIndexList
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_exportIAttr => exportIAttr
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv
+      character(len=*),   optional, intent(IN)    :: iMaskTags
+      character(len=*),   optional, intent(IN)    :: rMaskTags
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(SP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - initial verson.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeInDataGGSP_'
+
+  integer :: i, ierr, j, length
+  type(String) :: DummStr
+  type(List) :: iMaskList, rMaskList
+  integer,  dimension(:), pointer :: iMask,iDummy ! INTEGER mask workspace
+  real(FP), dimension(:), pointer :: rMask,rDummy ! REAL mask workspace
+
+  logical :: RAttrIdentical ! flag to identify identical REAL attribute
+                            ! lists in inAv and outAv
+  integer :: NumSharedRAttr ! number of REAL attributes shared by inAv,outAv
+       ! Cross-index storage for shared REAL attributes of inAv,outAv
+  integer, dimension(:), pointer :: inAvIndices, outAvIndices
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv has no real attributes.'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes.'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes.'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes.'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated.'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv and outAv must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv and GGrid must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv and WeightSum must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Check for INTEGER masks.  If they are present, retrieve 
+       ! them and combine them into a single integer mask iMask(:)
+
+  if(present(iMaskTags)) then
+
+       ! allocate two arrays:  iMask (the final product), 
+       ! and iDummy (storage space for each mask as it is retrieved)
+
+     allocate(iMask(AttrVect_lsize(inAv)), iDummy(AttrVect_lsize(inAv)), &
+	      stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: allocate(iMask(...)...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+
+       ! Initialize all the elements of iMask to unity:
+     iMask = 1
+
+       ! turn the colon-delimited string of tags into a List:
+     call List_init(iMaskList,iMaskTags)
+     
+       ! Loop over the items in iMaskList, retrieving each mask
+       ! into the array iDummy, checking it (if CheckMasks=.TRUE.), 
+       ! and multiplying it element-by-element into the array iMask.
+
+     do i=1,List_nitem(iMaskList)
+       ! grab item as a String
+	call List_get(DummStr, i, iMaskList) 
+       ! use this String to identify an INTEGER GeneralGrid attribute
+       ! for export to iDummy(:)
+	call GeneralGrid_exportIAttr(GGrid, String_ToChar(DummStr), &
+	                             iDummy, length)
+
+	if(.not.(CheckMasks)) then ! Merely multiply iMask by iDummy:
+	   do j=1,length
+	      iMask(j) = iMask(j) * iDummy(j)
+	   end do
+	else ! check mask elements and include their effect on iMask
+	   do j=1,length
+	      select case(iDummy(j))
+	      case(0) ! zeroes out iMask(j)
+		 iMask(j) = 0
+	      case(1) ! leaves iMask(j) untouched
+	      case default ! shut down with an error
+		 write(stderr,'(5a,i8,a,i8)') myname_, &
+		      ':: ERROR--illegal mask value (must be 0 or 1).', &
+		      'Illegal value stored in mask ', &
+		      String_ToChar(DummStr),'(',j,')=',iDummy(j)
+		 call die(myname_)
+	      end select
+	   end do
+	endif ! if(CheckMasks)...
+       ! clean up dummy String DummStr
+	call String_clean(DummStr)
+     end do ! do i=1,List_nitem(iMaskList)...
+
+  endif ! if(present(iMaskTags))...
+
+       ! Check for REAL masks.  If they are present, retrieve 
+       ! them and combine them into a single real mask rMask(:)
+
+  if(present(rMaskTags)) then
+
+       ! allocate two arrays:  rMask (the final product), 
+       ! and rDummy (storage space for each mask as it is retrieved)
+
+     allocate(rMask(AttrVect_lsize(inAv)), rDummy(AttrVect_lsize(inAv)), &
+	      stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: allocate(rMask(...)...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+
+       ! Initialize all the elements of rMask to unity:
+     rMask = 1._FP
+
+       ! turn the colon-delimited string of tags into a List:
+     call List_init(rMaskList,rMaskTags)
+     
+       ! Loop over the items in rMaskList, retrieving each mask
+       ! into the array rDummy, checking it (if CheckMasks=.TRUE.), 
+       ! and multiplying it element-by-element into the array rMask.
+
+     do i=1,List_nitem(rMaskList)
+       ! grab item as a String
+	call List_get(DummStr, i, rMaskList) 
+       ! use this String to identify an INTEGER GeneralGrid attribute
+       ! for export to rDummy(:)
+	call GeneralGrid_exportRAttr(GGrid, String_ToChar(DummStr), &
+	                             rDummy, length)
+
+	if(.not.(CheckMasks)) then ! Merely multiply rMask by rDummy:
+	   do j=1,length
+	      rMask(j) = rMask(j) * rDummy(j)
+	   end do
+	else ! check mask elements and include their effect on rMask
+	   do j=1,length
+	      if((iDummy(j) >= 0.) .and. (iDummy(j) <= 1.)) then ! in [0,1]
+		 rMask(j) = rMask(j) * rDummy(j)
+	      else
+		 write(stderr,'(5a,i8,a,i8)') myname_, &
+		      ':: ERROR--illegal mask value (must be in [0.,1.]).', &
+		      'Illegal value stored in mask ', &
+		      String_ToChar(DummStr),'(',j,')=',rDummy(j)
+		 call die(myname_)
+	      endif
+	   end do
+	endif ! if(CheckMasks)...
+       ! clean up dummy String DummStr
+	call String_clean(DummStr)
+     end do ! do i=1,List_nitem(rMaskList)...
+
+  endif ! if(present(rMaskTags))...
+
+       ! Now we have (at most) a single INTEGER mask iMask(:) and 
+       ! a single REAL mask rMask(:).  Before we perform the merge,
+       ! we must tackle one more issue:  are the REAL attributes 
+       ! of inAv and outAv identical and in the same order?  If they
+       ! are, the merge is a straightforward double loop over the 
+       ! elements and over all the attributes.  If the attribute lists
+       ! differ, we must cross-reference common attributes, and store
+       ! their indices.
+
+  RAttrIdentical = List_identical(inAv%rList, outAv%rList)
+  if(.not.(RAttrIdentical)) then 
+       ! Determine the number of shared REAL attributes NumSharedRAttr,
+       ! and form cross-index tables inAvIndices, outAvIndices.
+     call SharedAttrIndexList(inAv, outAv, 'REAL', NumSharedRAttr, &
+                              inAvIndices, outAvIndices)
+  endif
+
+  if(present(rMaskTags)) then ! REAL masking stored in rMask(:)
+
+     if(present(iMaskTags)) then ! also INTEGER mask iMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		      rMask(i) * iMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i) * rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 rMask(i) * iMask(i) * &
+				 inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i) * rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)...
+
+     else ! rMask(:), but no iMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		                    rMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 rMask(i) * inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     endif ! if(present(iMaskTags))...
+
+  else ! No REAL Mask 
+
+     if(present(iMaskTags)) then ! Have iMask(:), but no rMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		                    iMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 iMask(i) * inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     else ! Neither iMask(:) nor rMask(:)--all elements weighted by unity
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + 1._FP
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		         inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + 1._FP
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     endif ! if(present(iMaskTags))...
+
+  endif ! if(present(rMaskTags))...
+
+       ! At this point the merge has been completed.  Now clean
+       ! up all allocated structures and temporary arrays.
+
+  if(present(iMaskTags)) then ! clean up integer mask work space
+     deallocate(iMask, iDummy, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(iMask,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+     call List_clean(iMaskList)
+  endif
+
+  if(present(rMaskTags)) then ! clean up real mask work space
+     deallocate(rMask, rDummy, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(rMask,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+     call List_clean(rMaskList)
+  endif
+
+  if(.not.(RAttrIdentical)) then ! clean up cross-reference tables
+     deallocate(inAvIndices, outAvIndices, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(inAvIndices,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+  endif
+
+ end subroutine MergeInDataGGSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+!
+! !IROUTINE: MergeInDataGGDP_ - merge in data from a component.
+!
+! !DESCRIPTION:
+! Double precision version of MergeInDataGGSP_
+!
+! !INTERFACE:
+
+ subroutine MergeInDataGGDP_(inAv, iMaskTags, rMaskTags, GGrid, &
+                             CheckMasks, outAv, WeightSum)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_realkinds, only : DP, FP
+
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => toChar
+
+      use m_List, only : List
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_get => get
+      use m_List, only : List_identical => identical
+      use m_List, only : List_allocated => allocated
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : SharedAttrIndexList
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_exportIAttr => exportIAttr
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(AttrVect),               intent(IN)    :: inAv
+      character(len=*),   optional, intent(IN)    :: iMaskTags
+      character(len=*),   optional, intent(IN)    :: rMaskTags
+      type(GeneralGrid),            intent(IN)    :: GGrid
+      logical,                      intent(IN)    :: CheckMasks
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      type(AttrVect),               intent(INOUT) :: outAv
+      real(DP),       dimension(:), pointer       :: WeightSum
+
+! !REVISION HISTORY:
+!       19Jun02 - Jay Larson <larson@mcs.anl.gov> - initial verson.
+!       10Jul02 - J. Larson <larson@mcs.anl.gov> - Improved argument 
+!                 checking.
+!_______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::MergeInDataGGDP_'
+
+  integer :: i, ierr, j, length
+  type(String) :: DummStr
+  type(List) :: iMaskList, rMaskList
+  integer,  dimension(:), pointer :: iMask,iDummy ! INTEGER mask workspace
+  real(FP), dimension(:), pointer :: rMask,rDummy ! REAL mask workspace
+
+  logical :: RAttrIdentical ! flag to identify identical REAL attribute
+                            ! lists in inAv and outAv
+  integer :: NumSharedRAttr ! number of REAL attributes shared by inAv,outAv
+       ! Cross-index storage for shared REAL attributes of inAv,outAv
+  integer, dimension(:), pointer :: inAvIndices, outAvIndices
+
+       ! Begin argument sanity checks...
+
+       ! Have the input arguments been allocated?
+
+  if(.not.(List_allocated(inAv%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT argument inAv has no real attributes.'
+     call die(myname_)
+  endif
+
+  if(.not.(List_allocated(outaV%rList))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUTPUT argument outAv has no real attributes.'
+     call die(myname_)
+  endif
+
+  if(present(iMaskTags)) then
+     if(.not.(List_allocated(GGrid%data%iList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Integer masking requested, but input argument GGrid ', &
+	     'has no integer attributes.'
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags)) then
+     if(.not.(List_allocated(GGrid%data%rList))) then
+	write(stderr,'(3a)') myname_, &
+	     'ERROR--Real masking requested, but input argument GGrid ', &
+	     'has no real attributes.'
+	call die(myname_)
+     endif
+  endif
+
+  if(.not.(associated(WeightSum))) then
+     write(stderr,'(2a)') myname_, &
+	  'ERROR--INPUT/OUPUT argument WeightSum has not been allocated.'
+     call die(myname_)
+  endif
+
+       ! Do the vector lengths match?
+
+  if(AttrVect_lsize(inAv) /= AttrVect_lsize(outAv)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of AttrVect arguments inAv and outAv must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'AttrVect_lsize(outAv) = ',AttrVect_lsize(outAv)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv) /= GeneralGrid_lsize(GGrid)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv and GGrid must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'AttrVect_lsize(outAv) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv) /= size(WeightSum)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: ERROR--Lengths of arguments inAv and WeightSum must match.', &
+	  'AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  'size(WeightSum) = ',size(WeightSum)
+     call die(myname_)
+  endif
+
+       ! ...end argument sanity checks.
+
+       ! Check for INTEGER masks.  If they are present, retrieve 
+       ! them and combine them into a single integer mask iMask(:)
+
+  if(present(iMaskTags)) then
+
+       ! allocate two arrays:  iMask (the final product), 
+       ! and iDummy (storage space for each mask as it is retrieved)
+
+     allocate(iMask(AttrVect_lsize(inAv)), iDummy(AttrVect_lsize(inAv)), &
+	      stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: allocate(iMask(...)...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+
+       ! Initialize all the elements of iMask to unity:
+     iMask = 1
+
+       ! turn the colon-delimited string of tags into a List:
+     call List_init(iMaskList,iMaskTags)
+     
+       ! Loop over the items in iMaskList, retrieving each mask
+       ! into the array iDummy, checking it (if CheckMasks=.TRUE.), 
+       ! and multiplying it element-by-element into the array iMask.
+
+     do i=1,List_nitem(iMaskList)
+       ! grab item as a String
+	call List_get(DummStr, i, iMaskList) 
+       ! use this String to identify an INTEGER GeneralGrid attribute
+       ! for export to iDummy(:)
+	call GeneralGrid_exportIAttr(GGrid, String_ToChar(DummStr), &
+	                             iDummy, length)
+
+	if(.not.(CheckMasks)) then ! Merely multiply iMask by iDummy:
+	   do j=1,length
+	      iMask(j) = iMask(j) * iDummy(j)
+	   end do
+	else ! check mask elements and include their effect on iMask
+	   do j=1,length
+	      select case(iDummy(j))
+	      case(0) ! zeroes out iMask(j)
+		 iMask(j) = 0
+	      case(1) ! leaves iMask(j) untouched
+	      case default ! shut down with an error
+		 write(stderr,'(5a,i8,a,i8)') myname_, &
+		      ':: ERROR--illegal mask value (must be 0 or 1).', &
+		      'Illegal value stored in mask ', &
+		      String_ToChar(DummStr),'(',j,')=',iDummy(j)
+		 call die(myname_)
+	      end select
+	   end do
+	endif ! if(CheckMasks)...
+       ! clean up dummy String DummStr
+	call String_clean(DummStr)
+     end do ! do i=1,List_nitem(iMaskList)...
+
+  endif ! if(present(iMaskTags))...
+
+       ! Check for REAL masks.  If they are present, retrieve 
+       ! them and combine them into a single real mask rMask(:)
+
+  if(present(rMaskTags)) then
+
+       ! allocate two arrays:  rMask (the final product), 
+       ! and rDummy (storage space for each mask as it is retrieved)
+
+     allocate(rMask(AttrVect_lsize(inAv)), rDummy(AttrVect_lsize(inAv)), &
+	      stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: allocate(rMask(...)...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+
+       ! Initialize all the elements of rMask to unity:
+     rMask = 1._FP
+
+       ! turn the colon-delimited string of tags into a List:
+     call List_init(rMaskList,rMaskTags)
+     
+       ! Loop over the items in rMaskList, retrieving each mask
+       ! into the array rDummy, checking it (if CheckMasks=.TRUE.), 
+       ! and multiplying it element-by-element into the array rMask.
+
+     do i=1,List_nitem(rMaskList)
+       ! grab item as a String
+	call List_get(DummStr, i, rMaskList) 
+       ! use this String to identify an INTEGER GeneralGrid attribute
+       ! for export to rDummy(:)
+	call GeneralGrid_exportRAttr(GGrid, String_ToChar(DummStr), &
+	                             rDummy, length)
+
+	if(.not.(CheckMasks)) then ! Merely multiply rMask by rDummy:
+	   do j=1,length
+	      rMask(j) = rMask(j) * rDummy(j)
+	   end do
+	else ! check mask elements and include their effect on rMask
+	   do j=1,length
+	      if((iDummy(j) >= 0.) .and. (iDummy(j) <= 1.)) then ! in [0,1]
+		 rMask(j) = rMask(j) * rDummy(j)
+	      else
+		 write(stderr,'(5a,i8,a,i8)') myname_, &
+		      ':: ERROR--illegal mask value (must be in [0.,1.]).', &
+		      'Illegal value stored in mask ', &
+		      String_ToChar(DummStr),'(',j,')=',rDummy(j)
+		 call die(myname_)
+	      endif
+	   end do
+	endif ! if(CheckMasks)...
+       ! clean up dummy String DummStr
+	call String_clean(DummStr)
+     end do ! do i=1,List_nitem(rMaskList)...
+
+  endif ! if(present(rMaskTags))...
+
+       ! Now we have (at most) a single INTEGER mask iMask(:) and 
+       ! a single REAL mask rMask(:).  Before we perform the merge,
+       ! we must tackle one more issue:  are the REAL attributes 
+       ! of inAv and outAv identical and in the same order?  If they
+       ! are, the merge is a straightforward double loop over the 
+       ! elements and over all the attributes.  If the attribute lists
+       ! differ, we must cross-reference common attributes, and store
+       ! their indices.
+
+  RAttrIdentical = List_identical(inAv%rList, outAv%rList)
+  if(.not.(RAttrIdentical)) then 
+       ! Determine the number of shared REAL attributes NumSharedRAttr,
+       ! and form cross-index tables inAvIndices, outAvIndices.
+     call SharedAttrIndexList(inAv, outAv, 'REAL', NumSharedRAttr, &
+                              inAvIndices, outAvIndices)
+  endif
+
+  if(present(rMaskTags)) then ! REAL masking stored in rMask(:)
+
+     if(present(iMaskTags)) then ! also INTEGER mask iMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		      rMask(i) * iMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i) * rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 rMask(i) * iMask(i) * &
+				 inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i) * rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)...
+
+     else ! rMask(:), but no iMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		                    rMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 rMask(i) * inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + rMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     endif ! if(present(iMaskTags))...
+
+  else ! No REAL Mask 
+
+     if(present(iMaskTags)) then ! Have iMask(:), but no rMask(:)
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + &
+		                    iMask(i) * inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		 iMask(i) * inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + iMask(i)
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     else ! Neither iMask(:) nor rMask(:)--all elements weighted by unity
+
+	if(RAttrIdentical) then ! straight masked multiply
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,AttrVect_nRAttr(inAv)
+		 outAv%rAttr(j,i) = outAv%rAttr(j,i) + inAv%rAttr(j,i)
+	      end do ! do j=1,AttrVect_nRAttr(inAv)
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + 1._FP
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	else ! use previously generated cross-indices
+	   do i=1, AttrVect_lsize(inAv)
+	      do j=1,NumSharedRAttr
+		 outAv%rAttr(outAVIndices(j),i) = &
+		      		 outAv%rAttr(outAvIndices(j),i) + &
+		      		         inAv%rAttr(inAvIndices(j),i) 
+	      end do ! do j=1,NumSharedRAttr
+       ! add in mask contribution to total of merge weights
+	      WeightSum(i) = WeightSum(i) + 1._FP
+	   end do ! do i=1,AttrVect_lsize(inAv)...
+	endif ! if(RAttrIdentical)
+
+     endif ! if(present(iMaskTags))...
+
+  endif ! if(present(rMaskTags))...
+
+       ! At this point the merge has been completed.  Now clean
+       ! up all allocated structures and temporary arrays.
+
+  if(present(iMaskTags)) then ! clean up integer mask work space
+     deallocate(iMask, iDummy, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(iMask,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+     call List_clean(iMaskList)
+  endif
+
+  if(present(rMaskTags)) then ! clean up real mask work space
+     deallocate(rMask, rDummy, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(rMask,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+     call List_clean(rMaskList)
+  endif
+
+  if(.not.(RAttrIdentical)) then ! clean up cross-reference tables
+     deallocate(inAvIndices, outAvIndices, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: deallocate(inAvIndices,...) failed with ierr = ',ierr
+	call die(myname_)
+     endif
+  endif
+
+ end subroutine MergeInDataGGDP_
+
+ end module m_Merge
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Navigator.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Navigator.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Navigator.F90	(revision 4775)
@@ -0,0 +1,666 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Navigator.F90,v 1.9 2004-04-21 22:47:09 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Navigator - An Object for Indexing Segments of a Vector
+!
+! !DESCRIPTION:
+! A {\em Navigator} is a table used to {\em index} or {\em Navigate} 
+!  segments of a vector, or segments of a dimension of a 
+! higher-dimensional array.  In MCT, this concept is embodied in 
+! the {\tt Navigator} datatype, which contains 
+! the following components:
+! \begin{itemize}
+! \item The {\em number} of segments;
+! \item The {\em displacement} of the starting index of each segment 
+! from the vector's first element (i.e. the starting index minus 1);
+! \item The {\em length} of each segment; and
+! \item The {\em total length} of the vector or array dimension for which 
+! segments are defined.  This last item is optional, but if defined 
+! provides the ability for the {\tt Navigator} to check for erroneous
+! segment entries (i.e., segments that are out-of-bounds).
+! \end{itemize}
+!
+! This module defines the {\tt Navigator} datatype, creation and 
+! destruction methods, a variety of query methods, and a method for 
+! resizing the {\tt Navigator}.
+!
+! !INTERFACE:
+
+ module m_Navigator
+
+! !USES:
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: Navigator		! The class data structure
+
+    Type Navigator
+      integer :: NumSegments	! Number of defined Segments
+      integer :: VectorLength	! Length of the Vector being indexed
+      integer,pointer,dimension(:) :: displs ! Segment start displacements
+      integer,pointer,dimension(:) :: counts ! Segment lengths
+    End Type Navigator
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: Navigator_init,init ! initialize an object
+      public :: clean               ! clean an object
+      public :: NumSegments         ! number of vector segments
+      public :: VectorLength        ! indexed vector's total length
+      public :: msize               ! the maximum size
+      public :: resize              ! adjust the true size
+      public :: get                 ! get an entry
+      public :: ptr_displs          ! referencing %displs(:)
+      public :: ptr_counts          ! referencing %counts(:)
+
+    interface Navigator_init; module procedure	&
+       init_
+    end interface
+    interface init  ; module procedure init_  ; end interface
+    interface clean ; module procedure clean_ ; end interface
+    interface NumSegments ; module procedure  &
+       NumSegments_
+    end interface
+    interface VectorLength ; module procedure  &
+       VectorLength_
+    end interface
+    interface msize ; module procedure msize_ ; end interface
+    interface resize; module procedure resize_; end interface
+    interface get   ; module procedure get_   ; end interface
+    interface ptr_displs; module procedure &
+       ptr_displs_
+    end interface
+    interface ptr_counts; module procedure &
+       ptr_counts_
+    end interface
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> - initial prototype/prolog/code
+! 26Aug02 - J. Larson <larson@mcs.anl.gov> - expanded datatype to inlcude
+!           VectorLength component.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Navigator'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Create a Navigator
+!
+! !DESCRIPTION:
+! This routine creates a {\tt Navigator} {\tt Nav} capable of storing 
+! information about {\tt NumSegments} segments.  The user can supply the 
+! length of the vector (or array subspace) being indexed by supplying the 
+! optional input {\tt INTEGER} argument {\tt VectorLength} (if it is not 
+! supplied, this component of {\tt Nav} will be set to zero, signifying 
+! to other {\tt Navigator} routines that vector length information is 
+! unavailable).  The success (failure) of this operation is signified by 
+! the zero (non-zero) value of the optional output {\tt INTEGER} argument 
+! {\tt stat}.
+!
+! !INTERFACE:
+
+    subroutine init_(Nav, NumSegments, VectorLength, stat)
+
+! !USES:
+
+      use m_mall,only : mall_ison,mall_mci
+      use m_die ,only : die,perr
+      use m_stdio, only : stderr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,                   intent(in)  :: NumSegments
+      integer,         optional, intent(in)  :: VectorLength
+
+! !OUTPUT PARAMETERS:
+
+      type(Navigator),           intent(out) :: Nav
+      integer,         optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::init_'
+  integer :: ier
+
+! If the argument VectorLength is present, use this value to set 
+! Nav%VectorLength.  Otherwise, set Nav%VectorLength to zero.
+
+  if(present(VectorLength)) then
+     if(VectorLength < 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: FATAL -- illegal value of VectorLength=',VectorLength
+	call die(myname_)
+     endif
+     Nav%VectorLength = VectorLength
+  else
+     Nav%VectorLength = 0
+  endif
+
+! Allocate segment attribute table arrays:
+
+  allocate(Nav%displs(NumSegments),Nav%counts(NumSegments),stat=ier)
+  if(ier/=0) then
+     call perr(myname_,'allocate()',ier)
+     if(.not.present(stat)) call die(myname_)
+     stat=ier
+     return
+  endif
+  if(mall_ison()) then
+     call mall_mci(Nav%displs,myname)
+     call mall_mci(Nav%counts,myname)
+  endif
+
+  Nav%NumSegments=NumSegments
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a Navigator
+!
+! !DESCRIPTION:
+! This routine deallocates allocated memory associated with the 
+! input/output {\tt Navigator} argument {\tt Nav}, and clears the 
+! vector length and number of segments components  The success (failure) 
+! of this operation is signified by the zero (non-zero) value of the 
+! optional output {\tt INTEGER} argument {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine clean_(Nav, stat)
+
+! !USES:
+
+      use m_mall, only : mall_ison,mall_mco
+      use m_die,  only : warn
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(Navigator),intent(inout) :: Nav
+
+! !OUTPUT PARAMETERS:
+
+      integer,optional,intent(out) :: stat
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  if(mall_ison()) then
+     if(associated(Nav%displs)) call mall_mco(Nav%displs,myname_)
+     if(associated(Nav%counts)) call mall_mco(Nav%counts,myname_)
+  endif
+
+  deallocate(Nav%displs,Nav%counts,stat=ier)
+
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(Nav%...)',ier)
+  endif
+
+  Nav%NumSegments = 0
+  Nav%VectorLength = 0
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: NumSegments_ - Return the Number of Segments
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the number of segments 
+! in the input {\tt Navigator} argument {\tt Nav} for which segment 
+! start and length information are defined .
+!
+! !INTERFACE:
+
+ integer function NumSegments_(Nav)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator), intent(in) :: Nav
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> initial prototype/prolog/code
+!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> - removed die to prevent crashes.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::NumSegments_'
+
+  NumSegments_=Nav%NumSegments
+
+ end function NumSegments_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: msize_ - Return the Maximum Capacity for Segment Storage
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the maximum number of 
+! segments for which start and length information can be stored in the 
+! input {\tt Navigator} argument {\tt Nav}.
+!
+! !INTERFACE:
+
+ integer function msize_(Nav)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator),intent(in) :: Nav
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::msize_'
+
+  msize_=size(Nav%displs)
+
+ end function msize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: VectorLength_ - Return the Navigated Vector's Length
+!
+! !DESCRIPTION:
+! This {\tt INTEGER} query function returns the total length of the 
+! vector navigated by the input {\tt Navigator} argument {\tt Nav}.
+! Note that the vector length is a quantity the user must have set 
+! when {\tt Nav} was initialized.  If it has not been set, the return 
+! value will be zero.
+!
+! !INTERFACE:
+
+ integer function VectorLength_(Nav)
+
+! !USES:
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator), intent(in) :: Nav
+
+! !REVISION HISTORY:
+! 26Aug02 - J. Larson <larson@mcs.anl.gov> - initial implementation
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::VectorLength_'
+
+  VectorLength_=Nav%VectorLength
+
+ end function VectorLength_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: resize_ - Reset the Number of Segments
+!
+! !DESCRIPTION:
+! This routine resets the number of segments stored in the input/output 
+! {\tt Navigator} argument {\tt Nav}.  It behaves in one of two modes:  
+! If the optional {\tt INTEGER} input argument {\tt NumSegments} is 
+! provided, then this value is taken to be the new number of segments.
+! If this routine is invoked without {\tt NumSegments} provided, then 
+! the new number of segments is set as per the result of the Fortran 
+! {\tt size()} function applied to the segment table arrays.
+!
+! !INTERFACE:
+
+ subroutine resize_(Nav, NumSegments)
+ 
+! !USES:
+   
+      use m_stdio, only : stderr
+      use m_die,  only : die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,optional,intent(in) :: NumSegments
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(Navigator),intent(inout) :: Nav
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::resize_'
+  integer :: m
+
+  m=msize_(Nav)
+
+  if(present(NumSegments)) then
+     if(NumSegments > m) then
+	write(stderr,'(3a,2(i8,a))') myname_, &
+	     ':: FATAL value of argument NumSegments exceeds maximum ', &
+	     ' storage for this Navigator.  NumSegments = ',NumSegments, &
+	     ' Maximum storage capacity = ',m,' segments.'
+	call die(myname_)
+     endif
+     Nav%NumSegments=NumSegments
+  else
+     Nav%NumSegments=m
+  endif
+
+ end subroutine resize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: get_ - Retrieve Characteristics of a Segment
+!
+! !DESCRIPTION:
+! This multi-purpose query routine can be used to retrieve various 
+! characteristics of a given segment (identified by the input 
+! {\tt INTEGER} argument {\tt iSeg}) stored in the input {\tt Navigator}
+! argument {\tt Nav}:
+! \begin{enumerate}
+! \item The {\em displacement} of the first element in this segment from 
+! the first element of the vector.  This quantity is returned in the 
+! optional output {\tt INTEGER} argument {\tt displ}
+! \item The {\em number of elements} in this segment.  This quantity 
+! is returned in the optional output {\tt INTEGER} argument {\tt displ}
+! \item The {\em index} of the first element in this segment  This 
+! quantity is returned in the optional output {\tt INTEGER} argument 
+! {\tt lc}.
+! \item The {\em index} of the final element in this segment  This 
+! quantity is returned in the optional output {\tt INTEGER} argument 
+! {\tt le}.
+! \end{enumerate}
+! Any combination of the above characteristics may be obtained by 
+! invoking this routine with the corresponding optional arguments.
+!
+! !INTERFACE:
+
+ subroutine get_(Nav, iSeg, displ, count, lc, le)
+
+! !USES:
+
+      use m_stdio, only : stderr
+      use m_die,  only : die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator),           intent(in)  :: Nav
+      integer,                   intent(in)  :: iSeg
+
+! !OUTPUT PARAMETERS:
+
+      integer,         optional, intent(out) :: displ
+      integer,         optional, intent(out) :: count
+      integer,         optional, intent(out) :: lc
+      integer,         optional, intent(out) :: le
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov>  initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::get_'
+
+
+       ! Argument sanity check:
+
+  if(iSeg > msize_(Nav)) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: FATAL -- Segment index out of Navigator table bounds, ', &
+	  'Size of Navigator table = ',msize_(Nav),' iSeg = ',iSeg
+     call die(myname_)
+  endif
+
+  if(present(displ)) displ=Nav%displs(iSeg)
+  if(present(count)) count=Nav%counts(iSeg)
+  if(present(lc)) lc=Nav%displs(iSeg)+1
+  if(present(le)) le=Nav%displs(iSeg)+Nav%counts(iSeg)
+
+ end subroutine get_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ptr_displs_ - Returns Pointer to the displs(:) Component
+!
+! !DESCRIPTION:
+! This pointer-valued query function returns a pointer to the 
+! {\em displacements} information (the displacement of the first element 
+! of each segment from the beginning of the vector) contained in the 
+! input {\tt Navigator} argument {\tt Nav}.  It has four basic modes 
+! of behavior, depending on which (if any) of the optional input 
+! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd} are supplied.
+! \begin{enumerate}
+! \item  If neither {\tt lbnd} nor {\tt ubnd} is supplied, then 
+! {\tt ptr\_displs\_} returns a pointer to {\em all} the elements in 
+! the array {\tt Nav\%displs(:)}.
+! \item  If both {\tt lbnd} and {\tt ubnd} are supplied, then 
+! {\tt ptr\_displs\_} returns a pointer to the segment of the
+! array {\tt Nav\%displs(lbnd:ubnd)}.
+! \item  If {\tt lbnd} is supplied but {\tt ubnd} is not, then 
+! {\tt ptr\_displs\_} returns a pointer to the segment of the
+! array {\tt Nav\%displs(lbnd:msize)}, where {\tt msize} is the 
+! length of the array {\tt Nav\%displs(:)}.
+! \item  If {\tt lbnd} is not supplied but {\tt ubnd} is, then 
+! {\tt ptr\_displs\_} returns a pointer to the segment of the
+! array {\tt Nav\%displs(1:ubnd)}.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ function ptr_displs_(Nav, lbnd, ubnd)
+
+! !USES:
+
+      use m_stdio, only : stderr
+      use m_die,  only : die
+ 
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator),           intent(in) :: Nav
+      integer,         optional, intent(in) :: lbnd
+      integer,         optional, intent(in) :: ubnd
+
+! !OUTPUT PARAMETERS:
+
+      integer,     dimension(:), pointer    :: ptr_displs_
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ptr_displs_'
+  integer :: lc,le
+
+       ! Argument sanity checks
+
+  if(present(lbnd)) then
+     if(lbnd <= 0) then
+	write(stderr,'(3a,i8)') myname_, &
+	     ':: FATAL -- illegal lower bound, which must be >= 1.', &
+	     'lbnd = ',lbnd
+	call die(myname_)
+     endif
+  endif
+
+  if(present(ubnd)) then
+     if(ubnd > msize_(Nav)) then
+	write(stderr,'(2a,2(a,i8))') myname_, &
+	     ':: FATAL -- illegal upper bound, which must be <= msize(Nav).', &
+	     'msize(Nav) = ',msize_(Nav),' ubnd = ',ubnd
+	call die(myname_)
+     endif
+  endif
+
+  if(present(lbnd) .and. present(ubnd)) then
+     if(lbnd > ubnd) then
+	write(stderr,'(2a,2(a,i8))') myname_, &
+	     ':: FATAL --  upper bound, must be >= lower bound.', &
+	     'Lower bound lbnd = ',lbnd,' Upper bound ubnd = ',ubnd
+	call die(myname_)
+     endif
+  endif
+
+       ! End argument sanity checks
+
+  if(present(lbnd).or.present(ubnd)) then
+    lc=lbound(Nav%displs,1)
+    if(present(lbnd)) lc=lbnd
+    le=ubound(Nav%displs,1)
+    if(present(ubnd)) le=ubnd
+    ptr_displs_ => Nav%displs(lc:le)
+  else
+    le=Nav%NumSegments
+    ptr_displs_ => Nav%displs(1:le)
+  endif
+
+ end function ptr_displs_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ptr_counts_ - Returns Pointer to counts(:) Component
+!
+! !DESCRIPTION:
+! This pointer-valued query function returns a pointer to the 
+! {\em counts} information (that is, the number of elements in each 
+! of each segment the vector being navigated) contained in the 
+! input {\tt Navigator} argument {\tt Nav}.  It has four basic modes 
+! of behavior, depending on which (if any) of the optional input 
+! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd} are supplied.
+! \begin{enumerate}
+! \item  If neither {\tt lbnd} nor {\tt ubnd} is supplied, then 
+! {\tt ptr\_counts\_} returns a pointer to {\em all} the elements in 
+! the array {\tt Nav\%counts(:)}.
+! \item  If both {\tt lbnd} and {\tt ubnd} are supplied, then 
+! {\tt ptr\_counts\_} returns a pointer to the segment of the
+! array {\tt Nav\%counts(lbnd:ubnd)}.
+! \item  If {\tt lbnd} is supplied but {\tt ubnd} is not, then 
+! {\tt ptr\_counts\_} returns a pointer to the segment of the
+! array {\tt Nav\%counts(lbnd:msize)}, where {\tt msize} is the 
+! length of the array {\tt Nav\%counts(:)}.
+! \item  If {\tt lbnd} is not supplied but {\tt ubnd} is, then 
+! {\tt ptr\_counts\_} returns a pointer to the segment of the
+! array {\tt Nav\%counts(1:ubnd)}.
+! \end{enumerate}
+!
+! !INTERFACE:
+
+ function ptr_counts_(Nav, lbnd, ubnd)
+
+! !USES:
+
+      use m_stdio, only : stderr
+      use m_die,  only : die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(Navigator),           intent(in) :: Nav
+      integer,         optional, intent(in) :: lbnd
+      integer,         optional, intent(in) :: ubnd
+
+! !OUTPUT PARAMETERS:
+
+      integer, dimension(:),     pointer    :: ptr_counts_
+
+! !REVISION HISTORY:
+! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov>- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ptr_counts_'
+  integer :: lc,le
+
+       ! Argument sanity checks
+
+  if(present(lbnd)) then
+     if(lbnd <= 0) then
+	write(stderr,'(3a,i8)') myname_, &
+	     ':: FATAL -- illegal lower bound, which must be >= 1.', &
+	     'lbnd = ',lbnd
+	call die(myname_)
+     endif
+  endif
+
+  if(present(ubnd)) then
+     if(ubnd > msize_(Nav)) then
+	write(stderr,'(2a,2(a,i8))') myname_, &
+	     ':: FATAL -- illegal upper bound, which must be <= msize(Nav).', &
+	     'msize(Nav) = ',msize_(Nav),' ubnd = ',ubnd
+	call die(myname_)
+     endif
+  endif
+
+  if(present(lbnd) .and. present(ubnd)) then
+     if(lbnd > ubnd) then
+	write(stderr,'(2a,2(a,i8))') myname_, &
+	     ':: FATAL --  upper bound, must be >= lower bound.', &
+	     'Lower bound lbnd = ',lbnd,' Upper bound ubnd = ',ubnd
+	call die(myname_)
+     endif
+  endif
+
+       ! End argument sanity checks
+
+  if(present(lbnd).or.present(ubnd)) then
+    lc=lbound(Nav%counts,1)
+    if(present(lbnd)) lc=lbnd
+    le=ubound(Nav%counts,1)
+    if(present(ubnd)) le=ubnd
+    ptr_counts_ => Nav%counts(lc:le)
+  else
+    le=Nav%NumSegments
+    ptr_counts_ => Nav%counts(1:le)
+  endif
+
+ end function ptr_counts_
+
+ end module m_Navigator
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Rearranger.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Rearranger.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Rearranger.F90	(revision 4775)
@@ -0,0 +1,1343 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Rearranger.F90,v 1.33 2009-09-17 18:42:07 mickelso Exp
+! CVS MCT_2_8_0
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Rearranger -- Remaps an AttrVect within a group of processes
+!
+! !DESCRIPTION:
+! This module provides routines and datatypes for rearranging data
+! between two {\tt Attribute Vectors} defined on the same grid but
+! with two different {\tt GlobalSegMaps}.  ''Rearrange'' is a
+! generalized form of a parallel matrix transpose.
+! A parallel matrix transpose can take advantage of symmetry in the
+! data movement algorithm.  An MCT Rearranger makes no assumptions
+! about symmetry.
+!
+! When data needs to move between two components and the components
+! share any processors, use m\_Rearranger.  If the components are on
+! distinct sets of processors, use m\_Transfer.
+!
+! !SEE ALSO:
+!  m_Transfer
+! 
+!
+! !INTERFACE:
+
+ module m_Rearranger
+
+!
+! !USES:
+
+      use m_Router, only : Router
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC DATA MEMBERS:
+
+      public :: Rearranger  ! The class data structure
+
+      type :: Rearranger
+#ifdef SEQUENCE
+         sequence
+#endif
+         private 
+         type(Router) :: SendRouter
+         type(Router) :: RecvRouter
+         integer,dimension(:,:),pointer :: LocalPack
+         integer :: LocalSize
+      end type Rearranger
+
+! !PRIVATE DATA MEMBERS:
+      integer :: max_nprocs  ! size of MPI_COMM_WORLD used for generation of
+                             ! local automatic arrays
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init         ! creation method
+
+      public :: rearrange    ! the rearrange routine
+
+      public :: clean        ! destruction method
+      public :: print        ! print out comm info
+
+      interface init      ; module procedure init_      ; end interface
+      interface Rearrange ; module procedure Rearrange_ ; end interface
+      interface clean     ; module procedure clean_     ; end interface
+      interface print     ; module procedure print_     ; end interface
+
+! !DEFINED PARAMETERS:
+
+  integer,parameter                    :: DefaultTag = 500
+
+
+! !REVISION HISTORY:
+! 31Jan02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype
+! 04Jun02 - E.T. Ong <eong@mcs.anl.gov> - changed local copy structure to
+!           LocalSize. Made myPid a global process in MCTWorld.
+! 27Sep02 - R. Jacob <jacob@mcs.anl.gov> - Remove SrcAVsize and TrgAVsize
+!           and use Router%lAvsize instead for sanity check.
+! 25Jan08 - R. Jacob <jacob@mcs.anl.gov> - Add ability to handle unordered
+!           gsmaps.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Rearranger'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Init_ - Initialize a Rearranger
+!
+! !DESCRIPTION:
+! This routine takes two {\tt GlobalSegMap} inputs, {\tt SourceGSMap}
+! and {\tt TargetGSMap} and build a Rearranger {\tt OutRearranger}
+! between them. {\tt myComm} is used for the internal communication.
+!
+! {\bf N.B.} The two {\tt GlolbalSegMap} inputs must be initialized so
+! that the index values on a processor are in ascending order.
+!
+! !INTERFACE:
+
+ subroutine init_(SourceGSMap,TargetGSMap,myComm,OutRearranger)
+
+!
+! !USES:
+!
+
+   use m_MCTWorld,     only : ThisMCTWorld
+   use m_GlobalSegMap, only : GlobalSegMap
+   use m_GlobalSegMap, only : GSMap_lsize => lsize
+   use m_GlobalSegMap, only : GSMap_increasing => increasing
+   use m_Router,       only : Router     
+   use m_Router,       only : Router_init => init
+   use m_mpif90
+   use m_die
+   use m_stdio
+
+   implicit none
+  
+! !INPUT PARAMETERS:
+!
+   type(GlobalSegMap), intent(in)            :: SourceGSMap, TargetGSMap
+   integer,            intent(in)            :: myComm
+
+! !OUTPUT PARAMETERS:
+!
+   type(Rearranger),   intent(out)           :: OutRearranger
+
+! !REVISION HISTORY:
+! 31Jan02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype
+! 20Mar02 - E.T. Ong <eong@mcs.anl.gov> - working code
+! 05Jun02 - E.T. Ong <eong@mcs.anl.gov> - Use LocalPack
+! 30Mar06 - P. Worley <worleyph@ornl.gov> - added max_nprocs,
+!           used in communication optimizations in rearrange
+!EOP ___________________________________________________________________
+   character(len=*),parameter :: myname_=myname//'::init_'
+   integer,dimension(:,:),pointer :: temp_seg_starts,temp_seg_lengths
+   integer,dimension(:),pointer :: temp_pe_list,temp_numsegs,temp_locsize
+   integer :: temp_maxsize,temp_nprocs,maxsegcount
+   integer :: procindex,nprocs,nseg,len,myPid
+   integer :: src_seg_start,src_seg_length,trg_seg_start,trg_seg_length
+   integer :: i,j,k,l,m,n,ier
+   logical :: SendingToMyself,ReceivingFromMyself
+
+
+   ! Initialize Router component of Rearranger
+   call Router_init(SourceGSMap,TargetGSMap,myComm,OutRearranger%SendRouter)
+   call Router_init(TargetGSMap,SourceGSMap,myComm,OutRearranger%RecvRouter)
+
+   call MP_comm_size(MP_COMM_WORLD,max_nprocs,ier)
+   if(ier/=0) call MP_perr_die(myname_,'MP_comm_size',ier)
+
+   ! SANITY CHECK: Make sure that if SendRouter is sending to self, then,
+   ! by definition, RecvRouter is also receiving from self. If this is not 
+   ! true, then write to stderr and die. 
+
+   call MP_comm_rank(ThisMCTWorld%MCT_comm,myPid,ier)
+   if(ier/=0) call MP_perr_die(myname_,'MP_comm_rank',ier)
+
+   SendingToMyself = .false.
+   ReceivingFromMyself = .false.
+
+   do i=1,OutRearranger%SendRouter%nprocs
+      if(OutRearranger%SendRouter%pe_list(i) == myPid) then
+	 SendingToMyself = .true.
+      endif
+   enddo
+
+   do i=1,OutRearranger%RecvRouter%nprocs
+      if(OutRearranger%RecvRouter%pe_list(i) == myPid) then
+	 ReceivingFromMyself = .true.
+      endif
+   enddo
+
+   if( SendingToMyself.or.ReceivingFromMyself ) then
+      if( .not. (SendingToMyself.and.ReceivingFromMyself) ) then
+	 call die(myname_,"SendRouter is not compatible with RecvRouter")
+      endif
+   endif
+
+
+   ! If not sending to nor receiving from own processor then initialize 
+   ! the rearranger so that no local copy can be made. Then end the routine. 
+
+   if( .not. (SendingToMyself.or.ReceivingFromMyself) ) then
+      nullify(OutRearranger%LocalPack)
+      allocate(OutRearranger%LocalPack(0,0),stat=ier)
+      if(ier/=0) call die(myname_,'allocate(OutRearranger%LocalPack(0,0))',ier)
+      OutRearranger%LocalSize=0
+   endif
+
+
+   ! Start the process of Router modification: Router information for 
+   ! the local processor is extracted out and put into the local copy 
+   ! structure- Rearranger%LocalPack. Router structures are then reassigned 
+   ! to exclude the local copy information.
+
+
+   ! Operate on SendRouter and create local copy structures.
+
+   if( SendingToMyself.and.ReceivingFromMyself ) then
+
+   temp_nprocs = OutRearranger%SendRouter%nprocs-1
+   maxsegcount = SIZE(OutRearranger%SendRouter%seg_starts,2)
+
+   ! Allocate temporary Router structures to be used for modifying SendRouter 
+   nullify(temp_seg_starts,temp_seg_lengths,temp_pe_list, &
+           temp_numsegs,temp_locsize)
+   allocate(temp_seg_starts(temp_nprocs,maxsegcount), &
+            temp_seg_lengths(temp_nprocs,maxsegcount), &
+	    temp_pe_list(temp_nprocs), &
+            temp_numsegs(temp_nprocs), &
+            temp_locsize(temp_nprocs), stat=ier)
+   if(ier/=0) call die(myname_,'allocate(temp_seg_starts...)',ier)
+
+   temp_maxsize=0
+   procindex=0
+   nullify(OutRearranger%LocalPack)
+
+   ! Start assigning Rearranger copy structures and  
+   ! non-local Router components
+   do i=1,OutRearranger%SendRouter%nprocs
+
+      ! Gather local copy information 
+      if(OutRearranger%SendRouter%pe_list(i) == myPid) then
+
+	 ! Allocate Rearranger copy structure
+	 allocate(OutRearranger%LocalPack(2, &
+                  OutRearranger%SendRouter%locsize(i)),stat=ier)
+	 if(ier/=0) call die(myname_,'allocate(OutRearranger%LocalPack)',ier)
+	 OutRearranger%LocalPack = 0
+
+	 m=0
+	 do nseg = 1,OutRearranger%SendRouter%num_segs(i)
+	    src_seg_start = OutRearranger%SendRouter%seg_starts(i,nseg)
+	    src_seg_length = OutRearranger%SendRouter%seg_lengths(i,nseg)-1
+	    do len=0,src_seg_length
+	       m=m+1
+	       OutRearranger%LocalPack(2,m) = src_seg_start+len
+	    enddo
+	 enddo
+
+      else
+
+	 ! Gather non-local Router information
+	 procindex = procindex+1
+	 temp_seg_starts(procindex,1:maxsegcount) = &
+            OutRearranger%SendRouter%seg_starts(i,1:maxsegcount)
+	 temp_seg_lengths(procindex,1:maxsegcount) = &
+            OutRearranger%SendRouter%seg_lengths(i,1:maxsegcount)
+	 temp_pe_list(procindex) = OutRearranger%SendRouter%pe_list(i)
+	 temp_numsegs(procindex) = OutRearranger%SendRouter%num_segs(i)
+	 temp_locsize(procindex) = OutRearranger%SendRouter%locsize(i)
+	 temp_maxsize = max(temp_locsize(procindex),temp_maxsize)
+
+      endif
+
+   enddo
+
+   ! Copy SendRouter components back in
+
+   ! Deallocate existing SendRouter components
+   deallocate(OutRearranger%SendRouter%seg_starts,&
+              OutRearranger%SendRouter%seg_lengths, &
+	      OutRearranger%SendRouter%pe_list, &
+              OutRearranger%SendRouter%num_segs, &
+              OutRearranger%SendRouter%locsize,stat=ier)
+   if(ier/=0) call die(myname_, &
+                  'deallocate(OutRearranger%SendRouter%seg_starts...)',ier)
+
+   ! Re-allocate SendRouter components
+   allocate(OutRearranger%SendRouter%seg_starts(temp_nprocs,maxsegcount), &
+            OutRearranger%SendRouter%seg_lengths(temp_nprocs,maxsegcount), &
+	    OutRearranger%SendRouter%pe_list(temp_nprocs), &
+	    OutRearranger%SendRouter%num_segs(temp_nprocs), &
+            OutRearranger%SendRouter%locsize(temp_nprocs),stat=ier)
+   if(ier/=0) call die(myname_, &
+                   'allocate(OutRearranger%SendRouter%seg_starts...)',ier)      
+
+   ! Copy back in the spliced router information
+   OutRearranger%SendRouter%nprocs = temp_nprocs
+   OutRearranger%SendRouter%seg_starts(1:temp_nprocs,1:maxsegcount) = &
+      temp_seg_starts(1:temp_nprocs,1:maxsegcount)
+   OutRearranger%SendRouter%seg_lengths(1:temp_nprocs,1:maxsegcount) = &
+      temp_seg_lengths(1:temp_nprocs,1:maxsegcount)
+   OutRearranger%SendRouter%pe_list(1:temp_nprocs) = &
+      temp_pe_list(1:temp_nprocs)
+   OutRearranger%SendRouter%num_segs(1:temp_nprocs) = &
+      temp_numsegs(1:temp_nprocs)
+   OutRearranger%SendRouter%locsize(1:temp_nprocs) = &
+      temp_locsize(1:temp_nprocs)
+   OutRearranger%SendRouter%maxsize = temp_maxsize
+
+   deallocate(temp_seg_starts,temp_seg_lengths,temp_pe_list, &
+              temp_numsegs,temp_locsize,stat=ier)
+   if(ier/=0) call die(myname_,'deallocate(temp_seg_starts...)',ier)      
+
+
+   ! :::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+
+   ! Operate on RecvRouter and create local copy structures.
+
+   temp_nprocs = OutRearranger%RecvRouter%nprocs-1
+   maxsegcount = SIZE(OutRearranger%RecvRouter%seg_starts,2)
+
+  ! Allocate temporary Router structures to be used for modifying RecvRouter
+   nullify(temp_seg_starts,temp_seg_lengths,temp_pe_list, &
+           temp_numsegs,temp_locsize)
+   allocate(temp_seg_starts(temp_nprocs,maxsegcount), &
+            temp_seg_lengths(temp_nprocs,maxsegcount), &
+	    temp_pe_list(temp_nprocs),temp_numsegs(temp_nprocs), &
+            temp_locsize(temp_nprocs),stat=ier)
+   if(ier/=0) call die(myname_,'allocate(temp_seg_starts...)',ier)
+
+   temp_maxsize=0
+   procindex = 0
+
+   ! Start assigning Rearranger copy structures and  
+   ! non-local Router components
+   do i=1,OutRearranger%RecvRouter%nprocs
+
+      ! Gather local copy information 
+      if(OutRearranger%RecvRouter%pe_list(i) == myPid) then
+
+	 ! Senity Check for Router%locsize
+	 if( (SIZE(OutRearranger%LocalPack,2) /= &
+              OutRearranger%RecvRouter%locsize(i)) ) then
+	    call die(myname_, &
+                     'Router Error: Local RecvRouter%locsize(myPid) /=  &
+                     & Local SendRouter%locsize(myPid)')
+	 endif
+
+	 OutRearranger%LocalSize = OutRearranger%RecvRouter%locsize(i)
+
+	 m=0
+	 do nseg = 1,OutRearranger%RecvRouter%num_segs(i)
+	    trg_seg_start = OutRearranger%RecvRouter%seg_starts(i,nseg)
+	    trg_seg_length = OutRearranger%RecvRouter%seg_lengths(i,nseg)-1
+	    do len=0,trg_seg_length
+	       m=m+1
+	       OutRearranger%LocalPack(1,m) = trg_seg_start+len
+	    enddo
+	 enddo
+	 
+      else
+
+	 ! Gather non-local Router information
+	 procindex = procindex+1
+	 temp_seg_starts(procindex,1:maxsegcount) = &
+	    OutRearranger%RecvRouter%seg_starts(i,1:maxsegcount)
+	 temp_seg_lengths(procindex,1:maxsegcount) = &
+            OutRearranger%RecvRouter%seg_lengths(i,1:maxsegcount)
+	 temp_pe_list(procindex) = OutRearranger%RecvRouter%pe_list(i)
+	 temp_numsegs(procindex) = OutRearranger%RecvRouter%num_segs(i)
+	 temp_locsize(procindex) = OutRearranger%RecvRouter%locsize(i)
+	 temp_maxsize = max(temp_locsize(procindex),temp_maxsize)
+
+      endif
+
+   enddo
+
+   ! Copy RecvRouter components back in
+
+   ! Deallocate existing SendRouter components
+   deallocate(OutRearranger%RecvRouter%seg_starts, &
+              OutRearranger%RecvRouter%seg_lengths, &
+	      OutRearranger%RecvRouter%pe_list, &
+              OutRearranger%RecvRouter%num_segs, &
+              OutRearranger%RecvRouter%locsize,stat=ier)
+   if(ier/=0) call die(myname_, &
+                   'deallocate(OutRearranger%RecvRouter%seg_starts...)',ier)
+
+   ! Re-allocate RecvRouter components
+   allocate(OutRearranger%RecvRouter%seg_starts(temp_nprocs,maxsegcount), &
+            OutRearranger%RecvRouter%seg_lengths(temp_nprocs,maxsegcount), &
+	    OutRearranger%RecvRouter%pe_list(temp_nprocs), &
+	    OutRearranger%RecvRouter%num_segs(temp_nprocs), &
+            OutRearranger%RecvRouter%locsize(temp_nprocs),stat=ier)
+   if(ier/=0) call die(myname_, &
+                   'allocate(OutRearranger%RecvRouter%seg_starts...)',ier)      
+
+    ! Copy back in the spliced router information
+   OutRearranger%RecvRouter%nprocs = temp_nprocs
+   OutRearranger%RecvRouter%seg_starts(1:temp_nprocs,1:maxsegcount) =  &
+      temp_seg_starts(1:temp_nprocs,1:maxsegcount)
+   OutRearranger%RecvRouter%seg_lengths(1:temp_nprocs,1:maxsegcount) = &
+      temp_seg_lengths(1:temp_nprocs,1:maxsegcount)
+   OutRearranger%RecvRouter%pe_list(1:temp_nprocs) = &
+      temp_pe_list(1:temp_nprocs)
+   OutRearranger%RecvRouter%num_segs(1:temp_nprocs) = &
+      temp_numsegs(1:temp_nprocs)
+   OutRearranger%RecvRouter%locsize(1:temp_nprocs) = &
+      temp_locsize(1:temp_nprocs)
+   OutRearranger%RecvRouter%maxsize = temp_maxsize
+
+   deallocate(temp_seg_starts,temp_seg_lengths,temp_pe_list, &
+              temp_numsegs,temp_locsize,stat=ier)
+   if(ier/=0) call die(myname_,'deallocate(temp_seg_starts...)',ier)
+   
+   endif
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Clean a Rearranger
+!
+! !DESCRIPTION:
+! This routine deallocates allocated memory associated with the 
+! input/output {\tt Rearranger} argument {\tt ReArr}.  The success 
+! (failure) of this operation is reported in the zero (nonzero) value of
+! the optional output {\tt INTEGER} argument {\tt status}.
+!
+! !INTERFACE:
+
+ subroutine clean_(ReArr, status)
+
+!
+! !USES:
+!
+   use m_Router,only : Router     
+   use m_Router,only : Router_clean => clean
+   use m_mpif90
+   use m_die
+   use m_stdio
+
+   implicit none
+  
+! !INPUT/OUTPUT PARAMETERS:
+!
+   type(Rearranger),    intent(inout)           :: ReArr
+
+! !OUTPUT PARAMETERS:
+!
+   integer, optional,   intent(out)             :: status
+   
+! !REVISION HISTORY:
+! 31Jan02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype
+! 20Mar02 - E.T. Ong <eong@mcs.anl.gov> - working code
+!EOP ___________________________________________________________________
+   character(len=*),parameter :: myname_=myname//'::clean_'
+   integer :: ier
+
+        ! Set output status flag (if present) to zero, which assumes
+        ! success.
+
+   if(present(status)) status = 0
+
+        ! Clean up send and receive Routers:
+
+   call Router_clean(ReArr%SendRouter,ier)
+   if(ier /= 0) then
+      if(present(status)) then
+	 status = ier
+	 return
+      else
+         write(stderr,'(2a,i8)') myname_, &
+	   ':: ERROR--Router_clean(ReArr%SendRouter) failed with ier=',ier
+      endif
+   endif
+
+   call Router_clean(ReArr%RecvRouter,ier)
+   if(ier /= 0) then
+      if(present(status)) then
+	 status = ier
+	 return
+      else
+         write(stderr,'(2a,i8)') myname_, &
+	   ':: ERROR--Router_clean(ReArr%RecvRouter) failed with ier=',ier
+      endif
+   endif
+
+       ! Clean up Local on-PE copy buffer:
+
+   if(associated(ReArr%LocalPack)) then
+      deallocate(ReArr%LocalPack, stat=ier)
+      if(ier /= 0) then
+	 if(present(status)) then
+	    status=ier
+	 else
+	    write(stderr,'(2a,i8)') myname_, &
+	      ':: ERROR--deallocate(ReArr%LocalPack) failed with stat=',ier
+	 endif
+      endif
+   endif
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rearrange_ - Rearrange data between two Attribute Vectors
+!
+! !DESCRIPTION: 
+! This subroutine will take data in the {\tt SourceAv} Attribute
+! Vector and rearrange it to match the GlobalSegMap used to define
+! the {\tt TargetAv} Attribute Vector using the Rearrnger
+! {\tt InRearranger}.
+!
+! The optional argument {\tt Tag} can be used to set the tag value used in 
+! the rearrangement.  DefaultTag will be used otherwise.
+!
+! If the optional argument {\tt Sum} is present and true, data for the same
+! physical point coming from two or more processes will be summed.
+! Otherwise, data is overwritten.
+!
+! If the optional argument {\tt Vector} is present and true,
+! vector architecture-friendly parts of this routine will be invoked.
+!
+! If the optional argument {\tt AlltoAll} is present and true,
+! the communication will be done with an alltoall call instead of
+! individual sends and receives.
+!
+! The size of the {\tt SourceAv} and {\tt TargetAv}
+! argument must match those stored in the {\tt InRearranger} or
+! and error will result.
+!
+! {\bf N.B.:} {\tt SourceAv} and {\tt TargetAv} are
+! assumed to have exactly the same attributes
+! in exactly the same order.
+!
+! !INTERFACE:
+
+ subroutine rearrange_(SourceAVin,TargetAV,InRearranger,Tag,Sum,Vector,AlltoAll)
+
+!
+! !USES:
+!
+
+   use m_MCTWorld,only :MCTWorld
+   use m_MCTWorld,only :ThisMCTWorld
+   use m_AttrVect,  only : AttrVect
+   use m_AttrVect,  only : AttrVect_init => init
+   use m_AttrVect,  only : AttrVect_lsize => lsize
+   use m_AttrVect,  only : AttrVect_copy => copy
+   use m_AttrVect,  only : AttrVect_clean => clean
+   use m_AttrVect,  only : AttrVect_zero => zero
+   use m_AttrVect,  only : nIAttr,nRAttr
+   use m_AttrVect,  only : Permute,Unpermute
+   use m_Router,    only : Router     
+   use m_realkinds, only : FP
+   use m_mpif90
+   use m_die
+   use m_stdio
+
+   implicit none
+  
+! !INPUT/OUTPUT PARAMETERS:
+!
+   type(AttrVect),             intent(inout)   :: TargetAV
+   
+! !INPUT PARAMETERS:
+!
+   type(AttrVect),   target,   intent(in)      :: SourceAVin
+   type(Rearranger), target,   intent(in)      :: InRearranger
+   integer,          optional, intent(in)      :: Tag
+   logical,          optional, intent(in)      :: Sum
+   logical,          optional, intent(in)      :: Vector
+   logical,          optional, intent(in)      :: AlltoAll
+
+! !REVISION HISTORY:
+! 31Jan02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype
+! 20Mar02 - E.T. Ong <eong@mcs.anl.gov> - working code
+! 08Jul02 - E.T. Ong <eong@mcs.anl.gov> - change intent of Target,Source
+! 29Oct03 - R. Jacob <jacob@mcs.anl.gov> - add optional argument vector
+!           to control use of vector-friendly mods provided by Fujitsu.
+! 30Mar06 - P. Worley <worleyph@ornl.gov> - added alltoall option and
+!           reordered send/receive order to improve communication 
+!           performance.  Also remove replace allocated arrays with
+!           automatic.
+! 14Oct06 - R. Jacob <jacob@mcs.anl.gov> - check value of Sum argument.
+! 25Jan08 - R. Jacob <jacob@mcs.anl.gov> - Permute/unpermute if the internal
+!           routers permarr is defined.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Rearrange_'
+  integer ::	numi,numr,i,j,k,ier
+  integer ::    VectIndex,AttrIndex,seg_start,seg_end
+  integer ::    localindex,SrcVectIndex,TrgVectIndex,IAttrIndex,RAttrIndex
+  integer ::    proc,numprocs,nseg,pe,pe_shift,max_pe,myPid
+  integer ::    mp_Type_rp
+  integer ::    mytag
+  integer ::    ISendSize, RSendSize, IRecvSize, RRecvSize
+  logical ::    usevector, usealltoall
+  logical ::    DoSum
+  logical ::    Sendunordered
+  logical ::    Recvunordered
+  real(FP) ::  realtyp
+!-----------------------------------------------------------------------
+
+   ! DECLARE STRUCTURES FOR MPI ARGUMENTS.
+
+   ! declare arrays mapping from all processes to those sending to
+   ! or receiving from
+   integer :: SendList(0:max_nprocs-1)
+   integer :: RecvList(0:max_nprocs-1)
+
+   ! declare arrays to hold count and locations where data is to be sent from
+   integer :: ISendLoc(max_nprocs)
+   integer :: RSendLoc(max_nprocs)
+
+   integer :: ISendCnts(0:max_nprocs-1)
+   integer :: RSendCnts(0:max_nprocs-1)
+
+   integer :: ISdispls(0:max_nprocs-1)
+   integer :: RSdispls(0:max_nprocs-1)
+
+   ! declare arrays to hold data to be sent
+   integer,dimension(:),allocatable  :: ISendBuf
+   real(FP),dimension(:),allocatable :: RSendBuf
+
+   ! declare arrays to hold count and locations where data is to be received into
+   integer :: IRecvLoc(max_nprocs)
+   integer :: RRecvLoc(max_nprocs)
+
+   integer :: IRecvCnts(0:max_nprocs-1)
+   integer :: RRecvCnts(0:max_nprocs-1)
+
+   integer :: IRdispls(0:max_nprocs-1)
+   integer :: RRdispls(0:max_nprocs-1)
+
+   ! declare arrays to hold data to be received
+   integer,dimension(:),allocatable  :: IRecvBuf
+   real(FP),dimension(:),allocatable :: RRecvBuf
+
+   ! Structure to hold MPI request information for sends
+   integer :: send_ireqs(max_nprocs)
+   integer :: send_rreqs(max_nprocs)
+
+   ! Structure to hold MPI request information for sends
+   integer :: recv_ireqs(max_nprocs)
+   integer :: recv_rreqs(max_nprocs)
+
+   ! Structure to hold MPI status information for sends 
+   integer :: send_istatus(MP_STATUS_SIZE,max_nprocs)
+   integer :: send_rstatus(MP_STATUS_SIZE,max_nprocs)
+
+   ! Structure to hold MPI status information for sends 
+   integer :: recv_istatus(MP_STATUS_SIZE,max_nprocs)
+   integer :: recv_rstatus(MP_STATUS_SIZE,max_nprocs)
+
+   ! Pointer structure to make Router access simpler
+   type(Router), pointer :: SendRout, RecvRout
+   type(AttrVect),pointer :: SourceAv
+   type(AttrVect),target  :: SourceAvtmp
+
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+   Sendunordered=associated(InRearranger%SendRouter%permarr)
+   Recvunordered=associated(InRearranger%RecvRouter%permarr)
+
+   if(Sendunordered) then 
+      call AttrVect_init(SourceAvtmp,SourceAvin,AttrVect_lsize(SourceAvin))    
+      call AttrVect_copy(SourceAvin, SourceAvtmp)
+      call Permute(SourceAvtmp,InRearranger%SendRouter%permarr)
+      SourceAv => SourceAvtmp
+   else
+      SourceAv => SourceAvin
+   endif
+   
+   if(Recvunordered) call Permute(TargetAv,InRearranger%RecvRouter%permarr)
+
+   ! CHECK ARGUMENTS 
+
+   ! Check the size of the Source AttrVect
+   if(InRearranger%SendRouter%lAvsize /= AttrVect_lsize(SourceAV)) then
+      call warn(myname_,"SourceAV size is not appropriate for this Rearranger")
+      call die(myname_,"InRearranger%SendRouter%lAvsize",InRearranger%SendRouter%lAvsize, &
+	        "AttrVect_lsize(SourceAV)", AttrVect_lsize(SourceAV))
+   endif
+
+   ! Check the size of the Target AttrVect
+   if(InRearranger%RecvRouter%lAvsize /= AttrVect_lsize(TargetAV)) then
+      call warn(myname_,"TargetAV size is not appropriate for this Rearranger")
+      call die(myname_,"InRearranger%RecvRouter%lAvsize",InRearranger%RecvRouter%lAvsize, &
+	        "AttrVect_lsize(TargetAV)", AttrVect_lsize(TargetAV))
+   endif
+
+   ! Check the number of integer attributes 
+   if(nIAttr(SourceAV) /= nIAttr(TargetAV)) then
+      call warn(myname_, &
+                "Number of attributes in SourceAV and TargetAV do not match")
+      call die(myname_,"nIAttr(SourceAV)", nIAttr(SourceAV), &
+                        "nIAttr(TargetAV)", nIAttr(TargetAV))
+   endif
+
+   ! Check the number of real attributes
+   if(nRAttr(SourceAV) /= nRAttr(TargetAV)) then
+      call warn(myname_, &
+      "Number of attributes in SourceAV and TargetAV do not match")
+      call die(myname_,"nRAttr(SourceAV)", nRAttr(SourceAV), &
+                        "nRAttr(TargetAV)", nRAttr(TargetAV))
+   endif
+
+   usevector=.false.
+   if(present(Vector)) then
+    if(Vector) usevector=.true.
+   endif
+
+   usealltoall=.false.
+   if(present(Alltoall)) then
+    if(Alltoall) usealltoall=.true.
+   endif
+
+   DoSum=.false.
+   if(present(Sum)) then
+    if(Sum) DoSum=.true.
+   endif
+
+   ! ASSIGN VARIABLES
+
+
+   ! Get the number of integer and real attributes
+   numi = nIAttr(SourceAV)
+   numr = nRAttr(SourceAV)
+
+   ! Assign the pointers
+   nullify(SendRout,RecvRout)
+   SendRout => InRearranger%SendRouter
+   RecvRout => InRearranger%RecvRouter
+
+   mp_Type_rp=MP_Type(realtyp)
+
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! ALLOCATE DATA STRUCTURES !
+
+  ! IF SENDING DATA
+  if(SendRout%nprocs > 0) then
+
+     ! IF SENDING INTEGER DATA
+     if(numi .ge. 1) then
+
+	! allocate buffer to hold all outgoing data
+        ISendSize = 1
+	do proc=1,SendRout%nprocs
+           ISendLoc(proc) = ISendSize
+           ISendSize = ISendSize + SendRout%locsize(proc)*numi
+	enddo
+        ISendSize = ISendSize - 1        
+	allocate(ISendBuf(ISendSize),stat=ier)
+	if(ier/=0) call die(myname_,'allocate(ISendBuf)',ier)
+
+     endif
+
+     ! IF SENDING REAL DATA
+     if(numr .ge. 1) then
+
+	! allocate buffer to hold all outgoing data
+        RSendSize = 1
+	do proc=1,SendRout%nprocs
+           RSendLoc(proc) = RSendSize
+           RSendSize = RSendSize + SendRout%locsize(proc)*numr
+	enddo
+        RSendSize = RSendSize - 1        
+	allocate(RSendBuf(RSendSize),stat=ier)
+	if(ier/=0) call die(myname_,'allocate(RSendBuf)',ier)
+
+
+     endif
+
+  endif
+
+  ! IF RECEVING DATA
+  if(RecvRout%nprocs > 0) then
+
+     ! IF RECEIVING INTEGER DATA
+     if(numi .ge. 1) then
+
+	! allocate buffer to hold all outgoing data
+        IRecvSize = 1
+	do proc=1,RecvRout%nprocs
+           IRecvLoc(proc) = IRecvSize
+           IRecvSize = IRecvSize + RecvRout%locsize(proc)*numi
+	enddo
+        IRecvSize = IRecvSize - 1        
+	allocate(IRecvBuf(IRecvSize),stat=ier)
+	if(ier/=0) call die(myname_,'allocate(IRecvBuf)',ier)
+
+     endif
+
+     ! IF RECEIVING REAL DATA
+     if(numr .ge. 1) then
+
+	! allocate buffer to hold all outgoing data
+        RRecvSize = 1
+	do proc=1,RecvRout%nprocs
+           RRecvLoc(proc) = RRecvSize
+           RRecvSize = RRecvSize + RecvRout%locsize(proc)*numr
+	enddo
+        RRecvSize = RRecvSize - 1        
+	allocate(RRecvBuf(RRecvSize),stat=ier)
+	if(ier/=0) call die(myname_,'allocate(RRecvBuf)',ier)
+
+
+     endif
+
+  endif
+
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! INVERT PE LIST !
+  call MP_comm_rank(ThisMCTWorld%MCT_comm,myPid,ier)
+  if(ier/=0) call MP_perr_die(myname_,'MP_comm_rank',ier)
+
+  call MP_comm_size(ThisMCTWorld%MCT_comm, max_pe, ier)
+  if(ier/=0) call MP_perr_die(myname_,'MP_comm_size',ier)
+
+  SendList(:) = -1
+  do proc = 1,SendRout%nprocs
+     SendList(SendRout%pe_list(proc)) = proc
+  enddo
+
+  RecvList(:) = -1
+  do proc = 1,RecvRout%nprocs
+     RecvList(RecvRout%pe_list(proc)) = proc
+  enddo
+
+  if (usealltoall) then
+     ! CONSTRUCT CNTS AND DISPLS FOR ALLTOALLV !
+     ISendCnts(:) = 0
+     ISdispls(:)  = 0
+     RSendCnts(:) = 0
+     RSdispls(:)  = 0
+     IRecvCnts(:) = 0
+     IRdispls(:)  = 0
+     RRecvCnts(:) = 0
+     RRdispls(:)  = 0
+     do pe = 0,max_pe-1
+        proc = SendList(pe)
+        if (proc .ne. -1) then
+           ISendCnts(pe) = SendRout%locsize(proc)*numi
+           ISdispls(pe)  = ISendLoc(proc) - 1
+
+           RSendCnts(pe) = SendRout%locsize(proc)*numr
+           RSdispls(pe)  = RSendLoc(proc) - 1
+        endif
+
+        proc = RecvList(pe)
+        if (proc .ne. -1) then
+           IRecvCnts(pe) = RecvRout%locsize(proc)*numi
+           IRdispls(pe)  = IRecvLoc(proc) - 1
+
+           RRecvCnts(pe) = RecvRout%locsize(proc)*numr
+           RRdispls(pe)  = RRecvLoc(proc) - 1
+        endif
+     enddo
+  endif
+  
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+if (usealltoall) then
+
+  ! Load data going to each processor
+  do proc = 1,SendRout%nprocs
+     j=0
+     k=0
+
+     ! load the correct pieces of the integer and real vectors
+     do nseg = 1,SendRout%num_segs(proc)
+        seg_start = SendRout%seg_starts(proc,nseg)
+        seg_end = seg_start + SendRout%seg_lengths(proc,nseg)-1
+        do VectIndex = seg_start,seg_end
+           do AttrIndex = 1,numi
+              ISendBuf(ISendLoc(proc)+j) = SourceAV%iAttr(AttrIndex,VectIndex)
+              j=j+1
+           enddo
+           do AttrIndex = 1,numr
+              RSendBuf(RSendLoc(proc)+k) = SourceAV%rAttr(AttrIndex,VectIndex)
+              k=k+1
+           enddo
+        enddo
+     enddo
+  enddo
+
+else
+  ! POST MPI_IRECV
+
+  ! Load data coming from each processor
+  do pe_shift = 1,max_pe
+   proc = RecvList(mod(myPid+pe_shift,max_pe))
+    if (proc .ne. -1) then
+    
+     ! receive the integer data
+     if(numi .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag
+        if(present(Tag)) mytag=Tag
+
+	if( (RecvRout%num_segs(proc) > 1) .or. DoSum ) then
+
+	   call MPI_IRECV(IRecvBuf(IRecvLoc(proc)),                 &
+		          RecvRout%locsize(proc)*numi,MP_INTEGER,   &
+			  RecvRout%pe_list(proc),mytag,             &
+			  ThisMCTWorld%MCT_comm,recv_ireqs(proc),ier)
+
+	else
+
+	   call MPI_IRECV(TargetAV%iAttr(1,RecvRout%seg_starts(proc,1)), &
+		          RecvRout%locsize(proc)*numi,MP_INTEGER,        &
+                          RecvRout%pe_list(proc),mytag,                  &
+                          ThisMCTWorld%MCT_comm,recv_ireqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV(ints)',ier)
+
+     endif
+
+     ! receive the real data
+     if(numr .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag + 1
+        if(present(Tag)) mytag=Tag +1
+
+	if( (RecvRout%num_segs(proc) > 1) .or. DoSum ) then
+
+	   call MPI_IRECV(RRecvBuf(RRecvLoc(proc)),                 &
+		          RecvRout%locsize(proc)*numr,mp_Type_rp,   &
+			  RecvRout%pe_list(proc),mytag,             &
+			  ThisMCTWorld%MCT_comm,recv_rreqs(proc),ier)
+
+	else
+
+	   call MPI_IRECV(TargetAV%rAttr(1,RecvRout%seg_starts(proc,1)), &
+		          RecvRout%locsize(proc)*numr,mp_Type_rp,        &
+			  RecvRout%pe_list(proc),mytag,                  &
+			  ThisMCTWorld%MCT_comm,recv_rreqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV(reals)',ier)
+
+     endif
+    endif
+  enddo
+
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! POST MPI_ISEND
+
+  ! Load data going to each processor
+  do pe_shift = max_pe,1,-1
+   proc = SendList(mod(myPid+pe_shift,max_pe))
+    if (proc .ne. -1) then
+    
+     if( SendRout%num_segs(proc) > 1 ) then
+
+	j=0
+	k=0
+
+	! load the correct pieces of the integer and real vectors
+	do nseg = 1,SendRout%num_segs(proc)
+	   seg_start = SendRout%seg_starts(proc,nseg)
+	   seg_end = seg_start + SendRout%seg_lengths(proc,nseg)-1
+	   do VectIndex = seg_start,seg_end
+	      do AttrIndex = 1,numi
+		 ISendBuf(ISendLoc(proc)+j) = SourceAV%iAttr(AttrIndex,VectIndex)
+		 j=j+1
+	      enddo
+	      do AttrIndex = 1,numr
+		 RSendBuf(RSendLoc(proc)+k) = SourceAV%rAttr(AttrIndex,VectIndex)
+		 k=k+1
+	      enddo
+	   enddo
+	enddo
+
+     endif
+
+     ! send the integer data
+     if(numi .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag
+        if(present(Tag)) mytag=Tag
+
+	if( SendRout%num_segs(proc) > 1 ) then
+
+	   call MPI_ISEND(ISendBuf(ISendLoc(proc)),                 &
+		          SendRout%locsize(proc)*numi,MP_INTEGER,   &
+			  SendRout%pe_list(proc),mytag,             &
+			  ThisMCTWorld%MCT_comm,send_ireqs(proc),ier)
+
+	else
+
+	   call MPI_ISEND(SourceAV%iAttr(1,SendRout%seg_starts(proc,1)), &
+		          SendRout%locsize(proc)*numi,MP_INTEGER,        &
+                          SendRout%pe_list(proc),mytag,                  &
+                          ThisMCTWorld%MCT_comm,send_ireqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_ISEND(ints)',ier)
+
+     endif
+
+     ! send the real data
+     if(numr .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag +1
+        if(present(Tag)) mytag=Tag +1
+
+	if( SendRout%num_segs(proc) > 1 ) then
+
+	   call MPI_ISEND(RSendBuf(RSendLoc(proc)),                 &
+		          SendRout%locsize(proc)*numr,mp_Type_rp,   &
+			  SendRout%pe_list(proc),mytag,             &
+			  ThisMCTWorld%MCT_comm,send_rreqs(proc),ier)
+
+	else
+
+	   call MPI_ISEND(SourceAV%rAttr(1,SendRout%seg_starts(proc,1)), &
+		          SendRout%locsize(proc)*numr,mp_Type_rp,        &
+			  SendRout%pe_list(proc),mytag,                    &
+			  ThisMCTWorld%MCT_comm,send_rreqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_ISEND(reals)',ier)
+
+     endif
+    endif
+  enddo
+endif  ! end of else for if(usealltoall)
+!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! ZERO TARGETAV WHILE WAITING FOR MESSAGES TO COMPLETE
+
+  if(DoSum) call AttrVect_zero(TargetAV)
+
+!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! LOAD THE LOCAL PIECES OF THE INTEGER AND REAL VECTOR
+
+  if(usevector) then
+!$OMP PARALLEL DO PRIVATE(IAttrIndex,localindex,TrgVectIndex,SrcVectIndex)    
+     do IAttrIndex=1,numi
+!CDIR SELECT(VECTOR)
+!DIR$ CONCURRENT
+!DIR$ PREFERVECTOR
+     do localindex=1,InRearranger%LocalSize
+        TrgVectIndex = InRearranger%LocalPack(1,localindex)
+        SrcVectIndex = InRearranger%LocalPack(2,localindex)
+        TargetAV%iAttr(IAttrIndex,TrgVectIndex) = &
+             SourceAV%iAttr(IAttrIndex,SrcVectIndex)
+      enddo
+    enddo
+!$OMP PARALLEL DO PRIVATE(RAttrIndex,localindex,TrgVectIndex,SrcVectIndex)
+    do RAttrIndex=1,numr
+!CDIR SELECT(VECTOR)
+!DIR$ CONCURRENT
+!DIR$ PREFERVECTOR
+     do localindex=1,InRearranger%LocalSize
+        TrgVectIndex = InRearranger%LocalPack(1,localindex)
+        SrcVectIndex = InRearranger%LocalPack(2,localindex)
+        TargetAV%rAttr(RAttrIndex,TrgVectIndex) = &
+             SourceAV%rAttr(RAttrIndex,SrcVectIndex)
+     enddo
+    enddo
+
+  else
+!$OMP PARALLEL DO PRIVATE(localindex,TrgVectIndex,SrcVectIndex,IAttrIndex,RAttrIndex)
+    do localindex=1,InRearranger%LocalSize
+     TrgVectIndex = InRearranger%LocalPack(1,localindex)
+     SrcVectIndex = InRearranger%LocalPack(2,localindex)
+     do IAttrIndex=1,numi
+	TargetAV%iAttr(IAttrIndex,TrgVectIndex) = &
+	     SourceAV%iAttr(IAttrIndex,SrcVectIndex)
+     enddo
+     do RAttrIndex=1,numr
+	TargetAV%rAttr(RAttrIndex,TrgVectIndex) = &
+	     SourceAV%rAttr(RAttrIndex,SrcVectIndex)
+     enddo
+    enddo
+  endif
+
+!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+if (usealltoall) then
+
+  if (numi .ge. 1) then
+     call MPI_Alltoallv(ISendBuf, ISendCnts, ISdispls, MP_INTEGER, &
+                        IRecvBuf, IRecvCnts, IRdispls, MP_INTEGER, &
+                        ThisMCTWorld%MCT_comm,ier)
+  endif
+
+  if (numr .ge. 1) then
+     call MPI_Alltoallv(RSendBuf, RSendCnts, RSdispls, mp_Type_rp, &
+                        RRecvBuf, RRecvCnts, RRdispls, mp_Type_rp, &
+                        ThisMCTWorld%MCT_comm,ier)
+  endif
+
+else
+
+  ! WAIT FOR THE NONBLOCKING SENDS TO COMPLETE
+
+  if(SendRout%nprocs > 0) then
+
+     if(numi .ge. 1) then
+
+	call MPI_WAITALL(SendRout%nprocs,send_ireqs,send_istatus,ier)
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(ints)',ier)
+
+     endif
+
+     if(numr .ge. 1) then
+
+	call MPI_WAITALL(SendRout%nprocs,send_rreqs,send_rstatus,ier)
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(reals)',ier)
+
+     endif
+
+  endif
+
+endif
+!:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! WAIT FOR THE NONBLOCKING RECEIVES TO COMPLETE AND UNPACK BUFFER
+
+  do numprocs = 1,RecvRout%nprocs
+
+     if(numi .ge. 1) then
+
+if (usealltoall) then
+        proc = numprocs
+else
+        if(DoSum) then
+           proc = numprocs
+	   call MPI_WAIT(recv_ireqs(proc),recv_istatus,ier)
+        else
+	   call MPI_WAITANY(RecvRout%nprocs,recv_ireqs,proc,recv_istatus,ier)
+        endif
+endif
+
+	if(DoSum) then
+
+	   ! load the correct pieces of the integer vectors
+           j=0
+	   do nseg = 1,RecvRout%num_segs(proc)
+	      seg_start = RecvRout%seg_starts(proc,nseg)
+	      seg_end = seg_start + RecvRout%seg_lengths(proc,nseg)-1
+	      do VectIndex = seg_start,seg_end
+		 do AttrIndex = 1,numi
+		    TargetAV%iAttr(AttrIndex,VectIndex)= &
+                    TargetAV%iAttr(AttrIndex,VectIndex) + IRecvBuf(IRecvLoc(proc)+j)
+		    j=j+1
+		 enddo
+	      enddo
+	   enddo
+	   
+	else
+
+	   if (( RecvRout%num_segs(proc) > 1 ) .or. (usealltoall)) then
+
+	      ! load the correct pieces of the integer vectors
+              j=0
+	      do nseg = 1,RecvRout%num_segs(proc)
+		 seg_start = RecvRout%seg_starts(proc,nseg)
+		 seg_end = seg_start + RecvRout%seg_lengths(proc,nseg)-1
+		 do VectIndex = seg_start,seg_end
+		    do AttrIndex = 1,numi
+		       TargetAV%iAttr(AttrIndex,VectIndex)=IRecvBuf(IRecvLoc(proc)+j)
+		       j=j+1
+		    enddo
+		 enddo
+	      enddo
+	
+	   endif
+
+	endif ! end of if DoSum
+
+     endif  ! end of in numi>1
+
+     if(numr .ge. 1) then
+
+if (usealltoall) then
+        proc = numprocs
+else
+	if(DoSum) then
+           proc = numprocs
+	   call MPI_WAIT(recv_rreqs(proc),recv_rstatus,ier)
+        else
+	   call MPI_WAITANY(RecvRout%nprocs,recv_rreqs,proc,recv_rstatus,ier)
+        endif
+endif
+
+	if(DoSum) then
+
+	   ! load the correct pieces of the integer vectors
+           k=0
+	   do nseg = 1,RecvRout%num_segs(proc)
+	      seg_start = RecvRout%seg_starts(proc,nseg)
+	      seg_end = seg_start + RecvRout%seg_lengths(proc,nseg)-1
+	      do VectIndex = seg_start,seg_end
+		 do AttrIndex = 1,numr
+		    TargetAV%rAttr(AttrIndex,VectIndex) = &
+                    TargetAV%rAttr(AttrIndex,VectIndex) + RRecvBuf(RRecvLoc(proc)+k)
+		    k=k+1
+		 enddo
+	      enddo
+	   enddo
+	   
+	else
+
+	   if (( RecvRout%num_segs(proc) > 1 ) .or. (usealltoall)) then
+
+	      ! load the correct pieces of the integer vectors
+              k=0
+	      do nseg = 1,RecvRout%num_segs(proc)
+		 seg_start = RecvRout%seg_starts(proc,nseg)
+		 seg_end = seg_start + RecvRout%seg_lengths(proc,nseg)-1
+		 do VectIndex = seg_start,seg_end
+		    do AttrIndex = 1,numr
+		       TargetAV%rAttr(AttrIndex,VectIndex)=RRecvBuf(RRecvLoc(proc)+k)
+		       k=k+1
+		    enddo
+		 enddo
+	      enddo
+	   
+	   endif
+
+	endif  ! end if DoSum
+
+     endif  ! endif if numr>1
+
+  enddo
+
+  if(Sendunordered) then
+    call AttrVect_clean(SourceAvtmp)
+    nullify(SourceAv)
+  else
+    nullify(SourceAv)
+  endif
+
+  if(Recvunordered) call Unpermute(TargetAv,RecvRout%permarr)
+
+!::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+
+  ! DEALLOCATE ALL STRUCTURES
+
+  if(SendRout%nprocs > 0) then
+
+     if(numi .ge. 1) then
+
+	! Deallocate the send buffer
+	deallocate(ISendBuf,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(ISendBuf)',ier)
+
+     endif
+
+     if(numr .ge. 1) then
+
+	! Deallocate the send buffer
+	deallocate(RSendBuf,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(RSendBuf)',ier)
+
+     endif
+
+  endif
+
+  if(RecvRout%nprocs > 0) then
+
+     if(numi .ge. 1) then
+
+	! Deallocate the receive buffer
+	deallocate(IRecvBuf,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(IRecvBuf)',ier)
+
+     endif
+
+     if(numr .ge. 1) then
+
+	! Deallocate the receive buffer
+	deallocate(RRecvBuf,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(RRecvBuf)',ier)
+
+     endif
+
+  endif
+
+  nullify(SendRout,RecvRout)
+
+ end subroutine rearrange_
+
+
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: print_ - Print rearranger communication info
+!
+! !DESCRIPTION:
+! Print out communication info for both routers in a 
+! rearranger.  Print out on unit number 'lun'
+! e.g. (source,destination,length)
+!
+! !INTERFACE:
+
+    subroutine print_(rearr,mycomm,lun)
+!
+! !USES:
+!
+      use m_die
+      use m_Router, only: router_print => print
+
+      implicit none
+
+!INPUT/OUTPUT PARAMETERS:
+      type(Rearranger),      intent(in) :: rearr
+      integer, intent(in)           :: mycomm
+      integer, intent(in)           :: lun
+
+! !REVISION HISTORY:
+! 27Jul07 - R. Loy <rloy@mcs.anl.gov>  initial version
+!EOP ___________________________________________________________________
+
+
+      call router_print(rearr%SendRouter,mycomm,lun)
+      call router_print(rearr%RecvRouter,mycomm,lun)
+
+  end subroutine print_
+
+
+end module m_Rearranger
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Router.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Router.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Router.F90	(revision 4775)
@@ -0,0 +1,772 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Router.F90,v 1.49 2008-05-12 02:09:02 jacob Exp
+! CVS MCT_2_8_0
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Router -- Router class 
+!
+! !DESCRIPTION:
+! The Router data type contains all the information needed
+! to send an AttrVect between a component on M MPI-processes and a component
+! on N MPI-processes.   This module defines the Router datatype and provides
+! methods to create and destroy one.
+!
+! !INTERFACE:
+
+ module m_Router
+
+      use m_realkinds, only : FP
+
+      implicit none
+
+      private   ! except
+
+! !declare a private pointer structure for the real data
+      type :: rptr
+#ifdef SEQUENCE
+        sequence
+#endif
+        real(FP),dimension(:),pointer :: pr
+      end type
+
+! !declare a private pointer structure for the integer data
+      type :: iptr
+#ifdef SEQUENCE
+        sequence
+#endif
+        integer,dimension(:),pointer :: pi
+      end type
+
+! !PUBLIC TYPES:
+      public :: Router	        ! The class data structure
+
+      public :: rptr,iptr       ! pointer types used in Router
+!\end{verbatim}
+!% On return, pe_list is the processor ranks of the other
+!% component to receive from/send to.  num_segs is the
+!% number of segments out of my local AttrVect which must
+!% be sent/received.  (In general, these wont coincide exactly
+!% with the segments used to define the GlobalMap)
+!% seg_start is the start *in the local AttrVect* of each segment
+!%  (start goes from 1 to lsize(GSMap))
+!% and seg_lengths is the length.
+!\begin{verbatim}
+
+    type Router
+#ifdef SEQUENCE
+      sequence
+#endif
+      integer :: comp1id                           ! myid
+      integer :: comp2id                           ! id of second component
+      integer :: nprocs	                           ! number of procs to talk to
+      integer :: maxsize                           ! maximum amount of data going to a processor
+      integer :: lAvsize                           ! The local size of AttrVect which can be 
+                                                   ! used with this Router in MCT_Send/MCT_Recv
+      integer :: numiatt                           ! Number of integer attributes currently in use
+      integer :: numratt                           ! Number of real attributes currently in use
+      integer,dimension(:),pointer   :: pe_list    ! processor ranks of send/receive in MCT_comm
+      integer,dimension(:),pointer   :: num_segs   ! number of segments to send/receive
+      integer,dimension(:),pointer   :: locsize    ! total of seg_lengths for a proc
+      integer,dimension(:),pointer   :: permarr    ! possible permutation array
+      integer,dimension(:,:),pointer :: seg_starts ! starting index
+      integer,dimension(:,:),pointer :: seg_lengths! total length
+      type(rptr),dimension(:),pointer :: rp1       ! buffer to hold real data
+      type(iptr),dimension(:),pointer :: ip1       ! buffer to hold integer data
+      integer,dimension(:),pointer   :: ireqs,rreqs  ! buffer for MPI_Requests
+      integer,dimension(:,:),pointer :: istatus,rstatus  ! buffer for MPI_Status
+    end type Router
+
+! !PUBLIC MEMBER FUNCTIONS:
+      public :: init            ! Create a Router
+      public :: clean           ! Destroy a Router
+      public :: print           ! Print info about a Router
+
+
+    interface init  ; module procedure  &
+        initd_, &       ! initialize a Router between two seperate components
+        initp_ 	        ! initialize a Router locally with two GSMaps
+    end interface
+    interface clean ; module procedure clean_ ; end interface
+    interface print ; module procedure print_ ; end interface
+
+! !REVISION HISTORY:
+! 15Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> add locsize and maxsize 
+!           to Router type
+! 25Sep02 - R. Jacob <jacob@mcs.anl.gov> Remove type string.  Add lAvsize
+! 23Jul03 - R. Jacob <jacob@mcs.anl.gov> Add status and reqs arrays used
+!           in send/recv to the Router datatype.
+! 24Jul03 - R. Jacob <jacob@mcs.anl.gov> Add real and integer buffers
+!           for send/recv to the Router datatype.
+! 22Jan08 - R. Jacob <jacob@mcs.anl.gov> Add ability to handle an unordered
+!           GSMap by creating a new, ordered one and building Router from
+!           that.  Save permutation info in Router datatype.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Router'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initd_ - initialize a Router between two seperate components
+!
+! !DESCRIPTION:
+! The routine {\tt initd\_()} exchanges the {\tt GSMap} with the
+! component identified by {\tt othercomp} and then calls {\tt initp\_()}
+! to build a Router {\tt Rout} between them.
+!
+! {\bf N.B.} The  {\tt GSMap} argument must be declared so that the index values
+! on a processor are in ascending order.
+!
+! !INTERFACE:
+
+ subroutine initd_(othercomp,GSMap,mycomm,Rout )
+!
+! !USES:
+!
+      use m_GlobalSegMap, only :GlobalSegMap
+      use m_ExchangeMaps,only: MCT_ExGSMap => ExchangeMap
+      use m_mpif90
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      integer, intent(in)	       :: othercomp
+      integer, intent(in)	       :: mycomm
+      type(GlobalSegMap),intent(in)    :: GSMap     ! of the calling comp
+
+! !OUTPUT PARAMETERS:
+!
+      type(Router), intent(out)        :: Rout
+
+! !REVISION HISTORY:
+! 15Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 06Feb01 - R. Jacob <jacob@mcs.anl.gov> - Finish initialization
+!           of the Router.  Router now works both ways.
+! 25Apr01 - R. Jacob <jacob@mcs.anl.gov> - Eliminate early 
+!           custom code to exchange GSMap components and instead
+!           the more general purpose routine in m_ExchangeMaps.
+!           Use new subroutine OrderedPoints in m_GlobalSegMap
+!           to construct the vector of local and remote GSMaps.
+!           Clean-up code a little.
+! 03May01 - R. Jacob <jacob@mcs.anl.gov> - rename to initd and
+!           move most of code to new initp routine
+!
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initd_'
+
+  type(GlobalSegMap)    :: RGSMap  !  the other GSMap
+  integer ::		   ier
+
+!--------------------------begin code-----------------------
+
+!!!!!!!!!!!!!!!!!Exchange of global map data 
+
+  call MCT_ExGSMap(GSMap,mycomm,RGSMap,othercomp,ier)
+  if(ier /= 0) call die(myname_,'ExGSMap',ier)
+
+!!!!!!!!!!!!!!!!!Begin comparison of globalsegmaps
+
+  call initp_(GSMap,RGSMap, mycomm, Rout)
+
+ end subroutine initd_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initp_ - initialize a Router from two GlobalSegMaps
+!
+! !DESCRIPTION:
+!
+! Given two GlobalSegmentMaps {\tt GSMap} and {\tt RGSMap}, intialize a
+! Router {\tt Rout} between them.  Use local communicator {\tt mycomm}.
+!
+! {\bf N.B.} The two {\tt GSMap} arguments must be declared so that the index values
+! on a processor are in ascending order.
+!
+! !INTERFACE:
+
+ subroutine initp_(inGSMap,inRGSMap,mycomm,Rout )
+!
+! !USES:
+!
+      use m_GlobalSegMap,  only :GlobalSegMap
+      use m_GlobalSegMap,  only :ProcessStorage
+      use m_GlobalSegMap,  only :GSMap_comp_id => comp_id
+      use m_GlobalSegMap,  only :GSMap_increasing => increasing
+      use m_GlobalSegMap,  only :GlobalSegMap_copy => copy
+      use m_GlobalSegMap,  only :GlobalSegMap_init => init
+      use m_GlobalSegMap,  only :GlobalSegMap_clean => clean
+      use m_GlobalSegMap,  only :GlobalSegMap_OPoints => OrderedPoints
+      use m_GlobalSegMap,  only :GlobalSegMap_ngseg => ngseg  ! rml
+      use m_GlobalSegMap,  only :GlobalSegMap_nlseg => nlseg  ! rml
+      use m_GlobalSegMap,  only :GlobalSegMap_max_nlseg => max_nlseg  ! rml
+
+      use m_GlobalToLocal, only :GlobalToLocalIndex
+      use m_MCTWorld,      only :MCTWorld
+      use m_MCTWorld,      only :ThisMCTWorld
+
+      use m_Permuter      ,only:Permute
+      use m_MergeSorts    ,only:IndexSet
+      use m_MergeSorts    ,only:IndexSort
+
+      use m_mpif90
+      use m_die
+
+!      use m_zeit
+
+
+      use m_stdio    ! rml
+!      use shr_timer_mod        ! rml timers
+
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      type(GlobalSegMap), intent(in)	:: inGSMap
+      type(GlobalSegMap), intent(in)	:: inRGSMap
+      integer	     ,    intent(in)	:: mycomm
+
+! !OUTPUT PARAMETERS:
+!
+      type(Router),      intent(out)	:: Rout
+
+! !REVISION HISTORY:
+! 03May01 - R.L. Jacob <jacob@mcs.anl.gov> - Initial code brought
+!           in from old init routine.
+! 31Jul01 - Jace A Mogill <mogill@cray.com>
+!           Rewrote to reduce number of loops and temp storage
+! 26Apr06 - R. Loy <rloy@mcs.anl.gov> - recode the search through
+!           the remote GSMap to improve efficiency
+! 05Jan07 - R. Loy <rloy@mcs.anl.gov> - improved bound on size of 
+!           tmpsegcount and tmpsegstart
+! 15May07 - R. Loy <rloy@mcs.anl.gov> - improved bound on size of
+!           rgs_lb and rgs_ub
+! 25Jan08 - R. Jacob <jacob@mcs.anl.gov> - Dont die if GSMap is not
+!           increasing.  Instead, permute it to increasing and proceed.
+!EOP -------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'::initp_'
+  integer			     :: ier,i,j,k,m,n
+  integer			     :: mysize,myPid,othercomp
+  integer			     :: lmaxsize,totallength
+  integer                            :: maxsegcount,count
+  logical, dimension(:), allocatable :: tmppe_list
+  integer, dimension(:,:), pointer   :: tmpsegcount,tmpsegstart
+
+
+  integer :: my_left        ! Left point in local segment (global memory)
+  integer :: my_right       ! Right point in local segment (global memory)
+  integer :: r_left         ! Left point in remote segment (global memory)
+  integer :: r_right        ! Right point in remote segment (global memory)
+  integer :: nsegs_overlap  ! Number of segments that overlap between two procs
+
+
+  integer :: ngseg, nlseg
+  integer :: myseg, rseg
+  integer :: prev_right         ! Rightmost local point in previous overlapped segment
+  integer :: local_left, local_right
+  integer,allocatable  :: mygs_lb(:),mygs_ub(:),mygs_len(:),mygs_lstart(:)
+  integer :: r_ngseg
+  integer :: r_max_nlseg   ! max number of local segments in RGSMap
+  integer,allocatable  :: rgs_count(:),rgs_lb(:,:),rgs_ub(:,:)
+  integer,allocatable  :: nsegs_overlap_arr(:)
+
+  integer :: overlap_left, overlap_right, overlap_diff
+
+  integer :: proc, nprocs
+
+  integer :: max_rgs_count, max_overlap_segs
+  type(GlobalSegMap)	:: GSMap
+  type(GlobalSegMap)	:: RGSMap
+  integer, dimension(:), pointer   :: gpoints
+  integer, dimension(:), pointer   :: permarr
+  integer, dimension(:), pointer   :: rpermarr
+  integer  :: gmapsize
+
+
+  integer,save  :: t_initialized=0   ! rml timers
+  integer,save  :: t_loop            ! rml timers
+  integer,save  :: t_loop2            ! rml timers
+  integer,save  :: t_load            ! rml timers
+
+  call MP_comm_rank(mycomm,myPid,ier)
+  if(ier/=0) call MP_perr_die(myname_,'MP_comm_rank',ier)
+
+  nullify(Rout%permarr)
+
+  if (.not. GSMap_increasing(inGSMap)) then
+    if(myPid == 0) call warn(myname_,'GSMap indices not increasing...Will correct')
+    call GlobalSegMap_OPoints(inGSMap,myPid,gpoints)
+    gmapsize=ProcessStorage(inGSMap,myPid)
+    allocate(permarr(gmapsize), stat=ier)
+    if(ier/=0) call die(myname_,'allocate permarr',ier)
+    call IndexSet(permarr)
+    call IndexSort(permarr,gpoints)
+    call Permute(gpoints,permarr,gmapsize)
+    call GlobalSegMap_init(GSMap,gpoints,mycomm,inGSMap%comp_id,gsize=inGSMap%gsize)
+
+    allocate(Rout%permarr(gmapsize),stat=ier)
+    if(ier/=0) call die(myname_,'allocate Router%permarr',ier)
+    Rout%permarr(:)=permarr(:)
+
+    deallocate(gpoints,permarr, stat=ier)
+    if(ier/=0) call die(myname_,'deallocate gpoints,permarr',ier)
+
+  else
+    call GlobalSegMap_copy(inGSMap,GSMap)
+  endif
+
+  if (.not. GSMap_increasing(inRGSMap)) then
+    if(myPid == 0) call warn(myname_,'RGSMap indices not increasing...Will correct')
+    call GlobalSegMap_OPoints(inRGSMap,myPid,gpoints)
+    gmapsize=ProcessStorage(inRGSMap,myPid)
+    allocate(rpermarr(gmapsize), stat=ier)
+    if(ier/=0) call die(myname_,'allocate rpermarr',ier)
+    call IndexSet(rpermarr)
+    call IndexSort(rpermarr,gpoints)
+    call Permute(gpoints,rpermarr,gmapsize)
+
+    call GlobalSegMap_init(RGSMap,gpoints,mycomm,inRGSMap%comp_id,gsize=inRGSMap%gsize)
+
+    deallocate(gpoints,rpermarr, stat=ier)
+    if(ier/=0) call die(myname_,'deallocate gpoints,rpermarr',ier)
+  else
+    call GlobalSegMap_copy(inRGSMap,RGSMap)
+  endif
+
+
+#if 0
+   if (t_initialized == 0) then        ! rml timers
+     t_initialized=1                   ! rml timers
+
+     call shr_timer_get(t_loop,"m_Router:initp_ loop")  ! rml timers
+     call shr_timer_get(t_loop2,"m_Router:initp_ loop2")  ! rml timers
+     call shr_timer_get(t_load,"m_Router:initp_ load")  ! rml timers
+   endif
+#endif
+
+  mysize = ProcessStorage(GSMap,myPid)
+  othercomp = GSMap_comp_id(RGSMap)
+
+
+!.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  
+
+
+!!!!  call zeit_ci('t_loop2')
+!  call shr_timer_start(t_loop2)    ! rml timers
+
+
+!! 
+!! determine the global segments on this processor 
+!! just once, so the info be used repeatedly below
+!! same code was used in m_GlobalToLocal - should make a subroutine...
+!!
+
+  ngseg = GlobalSegMap_ngseg(GSMap)
+  nlseg = GlobalSegMap_nlseg(GSMap, myPid)
+
+  allocate( mygs_lb(nlseg), mygs_ub(nlseg), mygs_len(nlseg), &
+            mygs_lstart(nlseg), stat=ier )
+  if(ier/=0) call die(myname_,'allocate mygs',ier)
+
+  n = 0
+  do i=1,ngseg
+    if (GSMap%pe_loc(i) == myPid ) then
+      n=n+1
+      mygs_lb(n)=GSMap%start(i)
+      mygs_ub(n)=GSMap%start(i) + GSMap%length(i) -1
+      mygs_len(n)=GSMap%length(i)
+    endif
+  enddo
+
+  if (n .ne. nlseg) then
+    write(stderr,*) myname_,"mismatch nlseg",n,nlseg
+    call die(myname)
+  endif
+
+  if (nlseg > 0) mygs_lstart(1)=1
+  do i=2,nlseg
+    mygs_lstart(i)=mygs_lstart(i-1)+mygs_len(i-1)
+  enddo
+
+
+!!
+!! determine the segments in RGSMap that are local to each proc
+!!
+
+  nprocs=ThisMCTWorld%nprocspid(othercomp)
+  r_ngseg = GlobalSegMap_ngseg(RGSMap)
+
+  !! original size of rgs_lb()/ub() was (r_ngseg,nprocs)
+  !! at the cost of looping to compute it (within GlobalSegMap_max_nlseg),
+  !!   reduced size to (r_max_nlseg,nprocs)
+  !! further reduction could be made by flattening it to one dimension
+  !!   of size (r_ngseg) and allocating another array to index into it.
+  !!   would not improve overall mem use unless this were also done for
+  !!   tmpsegstart()/count() and possibly seg_starts()/lengths (the 
+  !!   latter would be a major change).
+
+  r_max_nlseg = GlobalSegMap_max_nlseg(RGSMap)
+
+  allocate( rgs_count(nprocs) , &
+            rgs_lb(r_max_nlseg,nprocs), rgs_ub(r_max_nlseg,nprocs), &
+            nsegs_overlap_arr(nprocs), stat=ier )
+  if(ier/=0) call die(myname_,'allocate rgs, nsegs',ier)
+
+
+  do proc = 1, nprocs
+
+     rgs_count(proc)=0                !! number of segments in RGSMap local to proc
+
+     do i=1,r_ngseg
+       if (RGSMap%pe_loc(i) == (proc-1) ) then
+
+         rgs_count(proc) = rgs_count(proc) +1
+
+         rgs_lb( rgs_count(proc) , proc )=RGSMap%start(i)
+         rgs_ub( rgs_count(proc) , proc )=RGSMap%start(i) + RGSMap%length(i) -1
+
+       endif
+     enddo
+
+  end do
+
+!!! 
+!!! this is purely for error checking
+
+  do proc = 1, nprocs
+    if (rgs_count(proc) > r_max_nlseg) then
+      write(stderr,*) myname_,"overflow on rgs array",proc,rgs_count(proc)
+      call die(myname_,'overflow on rgs',0)
+    endif
+  enddo
+
+!!!
+
+
+!!!!!!!!!!!!!!!!!!
+
+! allocate space for searching
+!   overlap segments to a given remote proc cannot be more than
+!   the max of the local segments and the remote segments
+
+  max_rgs_count=0
+  do proc=1,nprocs
+    max_rgs_count = max( max_rgs_count, rgs_count(proc) )
+  enddo
+
+  max_overlap_segs = max(nlseg,max_rgs_count)
+
+  allocate(tmpsegcount(ThisMCTWorld%nprocspid(othercomp), max_overlap_segs),&
+           tmpsegstart(ThisMCTWorld%nprocspid(othercomp), max_overlap_segs),&
+ 	   tmppe_list(ThisMCTWorld%nprocspid(othercomp)),stat=ier)
+  if(ier/=0)  &
+    call die( myname_,'allocate tmpsegcount etc. size ', &
+              ThisMCTWorld%nprocspid(othercomp), &
+              ' by ',max_overlap_segs)
+
+
+  tmpsegcount=0
+  tmpsegstart=0
+  count =0
+  maxsegcount=0
+
+!!!!!!!!!!!!!!!!!!
+
+
+  do proc = 1, nprocs
+    nsegs_overlap = 0
+    tmppe_list(proc) = .FALSE.         ! no overlaps with proc yet
+
+    if ( rgs_count(proc) > 0 ) then
+      do myseg = 1, nlseg                  ! loop over local segs on 'myPID'
+
+        my_left = mygs_lb(myseg)
+        my_right= mygs_ub(myseg)
+
+        do rseg = 1, rgs_count(proc)       !   loop over remote segs on 'proc'
+
+          r_left  = rgs_lb(rseg,proc)
+          r_right = rgs_ub(rseg,proc)
+
+          if (.not. (my_right < r_left   .or.  &     ! overlap
+                     my_left  > r_right) ) then
+
+             if (nsegs_overlap == 0) then        ! first overlap w/this proc
+               count = count + 1
+               tmppe_list(proc) = .TRUE.
+               prev_right = -9999
+             else
+               prev_right = local_right
+             endif
+
+             overlap_left=max(my_left, r_left)
+             overlap_right=min(my_right, r_right)
+             overlap_diff= overlap_right - overlap_left
+
+             local_left  = mygs_lstart(myseg) + (overlap_left - my_left)
+             local_right = local_left + overlap_diff
+
+                                                   ! non-contiguous w/prev one
+             if (local_left /= (prev_right+1) ) then
+               nsegs_overlap = nsegs_overlap + 1
+               tmpsegstart(count, nsegs_overlap) = local_left
+             endif
+
+             tmpsegcount(count, nsegs_overlap) = &
+               tmpsegcount(count, nsegs_overlap) + overlap_diff + 1
+
+           endif
+        enddo
+      enddo
+    endif
+
+    nsegs_overlap_arr(proc)=nsegs_overlap
+  enddo
+
+  !! pull this out of the loop to vectorize
+  do proc=1,nprocs
+    maxsegcount=max(maxsegcount,nsegs_overlap_arr(proc))
+  enddo
+
+
+  if (maxsegcount > max_overlap_segs) &
+    call die( myname_,'overran max_overlap_segs =', &
+              max_overlap_segs, ' count = ',maxsegcount)
+
+!  write(stderr,*) 'max_overlap_segs =', max_overlap_segs, &
+!                  'maxsegcount =',maxsegcount, &
+!                  'mysize =',mysize
+
+
+  deallocate( mygs_lb, mygs_ub, mygs_len, mygs_lstart, &
+              rgs_count, rgs_lb, rgs_ub, &
+              nsegs_overlap_arr, stat=ier)
+  if(ier/=0) call die(myname_,'deallocate mygs,rgs,nsegs',ier)
+
+
+!  call shr_timer_stop(t_loop2)    ! rml timers
+!!!!  call zeit_co('t_loop2')
+!!!!  call zeit_flush(6)
+! this doesn't seem to work
+!  call zeit_allflush(mycomm,0,6)
+
+
+
+!.  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  
+
+
+!!!!!!!!!!!!!!!!!!!!end of search through remote GSMap
+
+! start loading up the Router with data
+
+!  call shr_timer_start(t_load)    ! rml timers
+
+  Rout%comp1id = GSMap_comp_id(GSMap)
+  Rout%comp2id = othercomp
+  Rout%nprocs = count
+  Rout%numiatt = 0
+  Rout%numratt = 0
+
+  allocate(Rout%pe_list(count),Rout%num_segs(count), &
+    Rout%seg_starts(count,maxsegcount), &
+    Rout%seg_lengths(count,maxsegcount), &
+    Rout%locsize(count),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(Rout..)',ier)
+
+  allocate(Rout%istatus(MP_STATUS_SIZE,count), &
+             Rout%rstatus(MP_STATUS_SIZE,count), &
+	     Rout%rreqs(count),Rout%ireqs(count),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(status,reqs,...)',ier)
+
+! allocate the number of pointers needed
+  allocate(Rout%ip1(count),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(ip1)',ier)
+
+! allocate the number of pointers needed
+  allocate(Rout%rp1(count),stat=ier)
+  if(ier/=0) call die(myname_,'allocate(rp1)',ier)
+
+
+    
+  m=0
+  do i=1,ThisMCTWorld%nprocspid(othercomp)
+      if(tmppe_list(i))then 
+      m=m+1
+      ! load processor rank in MCT_comm
+      Rout%pe_list(m)=ThisMCTWorld%idGprocid(othercomp,i-1)
+      endif
+    enddo
+
+    lmaxsize=0
+    do i=1,count
+      totallength=0
+      do j=1,maxsegcount
+	if(tmpsegcount(i,j) /= 0) then
+	 Rout%num_segs(i)=j
+ 	 Rout%seg_starts(i,j)=tmpsegstart(i,j)
+	 Rout%seg_lengths(i,j)=tmpsegcount(i,j)
+	 totallength=totallength+Rout%seg_lengths(i,j)
+	endif
+      enddo
+      Rout%locsize(i)=totallength
+      lmaxsize=MAX(lmaxsize,totallength)
+    enddo
+
+    Rout%maxsize=lmaxsize
+    Rout%lAvsize=mysize
+
+      
+  deallocate(tmpsegstart,tmpsegcount,tmppe_list,stat=ier)
+  if(ier/=0) call die(myname_,'deallocate()',ier)
+
+  call GlobalSegMap_clean(RGSMap)
+  call GlobalSegMap_clean(GSMap)
+
+
+!  call shr_timer_stop(t_load)    ! rml timers
+
+ end subroutine initp_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a Router
+!
+! !DESCRIPTION:
+! Deallocate Router internal data structures and set integer parts to zero.
+!
+! !INTERFACE:
+
+    subroutine clean_(Rout,stat)
+!
+! !USES:
+!
+      use m_die
+
+      implicit none
+
+!INPUT/OUTPUT PARAMETERS:
+      type(Router),      intent(inout) :: Rout
+
+!OUTPUT PARAMETERS:
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 15Jan01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> - add code to clean
+!           the maxsize and locsize
+! 01Mar02 - E.T. Ong <eong@mcs.anl.gov> removed the die to prevent
+!           crashes and added stat argument.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  deallocate(Rout%pe_list,Rout%num_segs,Rout%seg_starts, &
+  Rout%locsize,Rout%seg_lengths,stat=ier)
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(Rout%pe_list,...)',ier)
+  endif
+
+  deallocate(Rout%rreqs,Rout%ireqs,Rout%rstatus,&
+   Rout%istatus,stat=ier)
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(Rout%rreqs,...)',ier)
+  endif
+
+  deallocate(Rout%ip1,Rout%rp1,stat=ier)
+  if(present(stat)) then
+     stat=ier
+  else
+     if(ier /= 0) call warn(myname_,'deallocate(Rout%ip1,...)',ier)
+  endif
+
+  if(associated(Rout%permarr)) then
+     deallocate(Rout%permarr,stat=ier)
+     if(present(stat)) then
+        stat=ier
+     else
+        if(ier /= 0) call warn(myname_,'deallocate(Rout%ip1,...)',ier)
+     endif
+  endif
+
+  Rout%comp1id = 0
+  Rout%comp2id = 0
+  Rout%nprocs = 0
+  Rout%maxsize = 0
+  Rout%lAvsize = 0
+  Rout%numiatt = 0
+  Rout%numratt = 0
+
+
+ end subroutine clean_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: print_ - Print router info
+!
+! !DESCRIPTION:
+! Print out communication info about router on unit number 'lun'
+! e.g. (source,destination,length)
+!
+! !INTERFACE:
+
+    subroutine print_(rout,mycomm,lun)
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+
+      implicit none
+
+!INPUT/OUTPUT PARAMETERS:
+      type(Router),      intent(in) :: Rout
+      integer, intent(in)           :: mycomm
+      integer, intent(in)           :: lun
+
+! !REVISION HISTORY:
+! 27Jul07 - R. Loy <rloy@mcs.anl.gov>  initial version
+!EOP ___________________________________________________________________
+
+
+    integer iproc
+    integer myrank
+    integer ier
+    character(len=*),parameter :: myname_=myname//'::print_'
+  
+    call MP_comm_rank(mycomm,myrank,ier)
+    if(ier/=0) call MP_perr_die(myname_,'MP_comm_rank',ier)
+
+
+    do iproc=1,rout%nprocs
+      if (rout%num_segs(iproc) > 0) then
+        write(lun,*) myrank,rout%pe_list(iproc),rout%locsize(iproc)
+      endif
+    end do        
+
+
+  end subroutine print_
+
+
+ end module m_Router
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrix.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrix.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrix.F90	(revision 4775)
@@ -0,0 +1,2767 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SparseMatrix.F90,v 1.31 2007-08-01 14:12:20 larson Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SparseMatrix -- Sparse Matrix Object
+!
+! !DESCRIPTION:
+! The {\tt SparseMatrix} data type is MCT's object for storing sparse 
+! matrices.  In MCT, intergrid interpolation is implemented as a sparse 
+! matrix-vector multiplication, with the {\tt AttrVect} type playing the 
+! roles of the input and output vectors.  The interpolation matrices tend
+! to be {\em extremely} sparse.  For ${\bf x} \in \Re^{N_x}$, and
+! ${\bf y} \in \Re^{N_y}$, the interpolation matrix {\bf M} used to effect 
+! ${\bf y} = {\bf M} {\bf x}$ will typically have ${\cal O}({N_y})$ 
+! non-zero elements.  For that reason, the {\tt SparseMatrix} type 
+! stores {\em only} information about non-zero matrix elements, along 
+! with the number of rows and columns in the full matrix.  The nonzero  
+! matrix elements are stored in {\tt AttrVect} form (see the module 
+! {\tt m\_AttrVect} for more details), and the set of attributes are 
+! listed below:
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|l|l|l|}
+!\hline
+!{\bf Attribute Name} & {\bf Significance} & {\tt Type} \\
+!\hline
+!{\tt grow} & Global Row Index & {\tt INTEGER} \\
+!\hline
+!{\tt gcol} & Global Column Index & {\tt INTEGER} \\
+!\hline
+!{\tt lrow} & Local Row Index & {\tt INTEGER} \\
+!\hline
+!{\tt lcol} & Local Column Index & {\tt INTEGER} \\
+!\hline
+!{\tt weight} & Matrix Element ${M_{ij}}$ & {\tt REAL} \\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+! 
+! The provision of both local and global column and row indices is 
+! made because this datatype can be used in either shared-memory or 
+! distributed-memory parallel matrix-vector products.
+!
+! This module contains the definition of the {\tt SparseMatrix} type, 
+! creation and destruction methods, a variety of accessor methods, 
+! routines for testing the suitability of the matrix for interpolation 
+! (i.e. the sum of each row is either zero or unity), and methods for 
+! sorting and permuting matrix entries.
+!
+! For better performance of the Matrix-Vector multiply on vector
+! architectures, the {\tt SparseMatrix} object also contains arrays
+! for holding the sparse matrix data in a more vector-friendly form.
+!
+!
+! !INTERFACE:
+
+ module m_SparseMatrix
+!
+! !USES:
+!
+      use m_realkinds, only : FP
+      use m_AttrVect, only : AttrVect
+
+
+      private   ! except
+
+! !PUBLIC TYPES:
+
+      public :: SparseMatrix      ! The class data structure
+
+      Type SparseMatrix
+#ifdef SEQUENCE
+     sequence
+#endif
+     integer :: nrows
+	 integer :: ncols
+	 type(AttrVect) :: data
+         logical :: vecinit       ! additional data for the vectorized sMat
+         integer,dimension(:),pointer :: row_s, row_e
+         integer, dimension(:,:), pointer :: tcol
+         real(FP), dimension(:,:), pointer :: twgt
+         integer :: row_max, row_min
+         integer :: tbl_end
+      End Type SparseMatrix
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init              ! Create a SparseMatrix
+      public :: vecinit           ! Initialize the vector parts
+      public :: clean             ! Destroy a SparseMatrix
+      public :: lsize             ! Local number of elements
+      public :: indexIA           ! Index integer attribute
+      public :: indexRA           ! Index real attribute
+      public :: nRows             ! Total number of rows
+      public :: nCols             ! Total number of columns
+
+      public :: exportGlobalRowIndices    ! Return global row indices 
+                                          ! for matrix elements
+      public :: exportGlobalColumnIndices ! Return global column indices 
+                                          ! for matrix elements
+      public :: exportLocalRowIndices     ! Return local row indices 
+                                          ! for matrix elements
+      public :: exportLocalColumnIndices  ! Return local column indices 
+                                          ! for matrix elements
+      public :: exportMatrixElements      ! Return matrix elements
+
+      public :: importGlobalRowIndices    ! Set global row indices 
+                                          ! using 
+      public :: importGlobalColumnIndices ! Return global column indices 
+                                          ! for matrix elements
+      public :: importLocalRowIndices     ! Return local row indices 
+                                          ! for matrix elements
+      public :: importLocalColumnIndices  ! Return local column indices 
+                                          ! for matrix elements
+      public :: importMatrixElements      ! Return matrix elements
+      public :: Copy                      ! Copy a SparseMatrix
+
+      public :: GlobalNumElements ! Total number of nonzero elements
+      public :: ComputeSparsity   ! Fraction of matrix that is nonzero
+      public :: local_row_range   ! Local (on-process) row range
+      public :: global_row_range  ! Local (on-process) row range
+      public :: local_col_range   ! Local (on-process) column range
+      public :: global_col_range  ! Local (on-process) column range
+      public :: CheckBounds       ! Check row and column values
+                                  ! for out-of-bounds values
+      public :: row_sum           ! Return SparseMatrix row sums
+      public :: row_sum_check     ! Check SparseMatrix row sums against
+                                  ! input "valid" values
+      public :: Sort              ! Sort matrix entries to generate an
+                                  ! index permutation (to be used by
+                                  ! Permute()
+      public :: Permute           ! Permute matrix entries using index
+                                  ! permutation gernerated by Sort()
+      public :: SortPermute       ! Sort/Permute matrix entries
+
+    interface init  ; module procedure init_  ; end interface
+    interface vecinit  ; module procedure vecinit_  ; end interface
+    interface clean ; module procedure clean_ ; end interface
+    interface lsize ; module procedure lsize_ ; end interface
+    interface indexIA ; module procedure indexIA_ ; end interface
+    interface indexRA ; module procedure indexRA_ ; end interface
+    interface nRows ; module procedure nRows_ ; end interface
+    interface nCols ; module procedure nCols_ ; end interface
+
+    interface exportGlobalRowIndices ; module procedure &
+	 exportGlobalRowIndices_ 
+    end interface
+
+    interface exportGlobalColumnIndices ; module procedure &
+	 exportGlobalColumnIndices_ 
+    end interface
+
+    interface exportLocalRowIndices ; module procedure &
+	 exportLocalRowIndices_ 
+    end interface
+
+    interface exportLocalColumnIndices ; module procedure &
+	 exportLocalColumnIndices_ 
+    end interface
+
+    interface exportMatrixElements ; module procedure &
+	 exportMatrixElementsSP_, &
+	 exportMatrixElementsDP_
+    end interface
+
+    interface importGlobalRowIndices ; module procedure &
+	 importGlobalRowIndices_ 
+    end interface
+
+    interface importGlobalColumnIndices ; module procedure &
+	 importGlobalColumnIndices_ 
+    end interface
+
+    interface importLocalRowIndices ; module procedure &
+	 importLocalRowIndices_ 
+    end interface
+
+    interface importLocalColumnIndices ; module procedure &
+	 importLocalColumnIndices_ 
+    end interface
+
+    interface importMatrixElements ; module procedure &
+	 importMatrixElementsSP_, & 
+	 importMatrixElementsDP_
+    end interface
+
+    interface Copy ; module procedure Copy_ ; end interface
+
+    interface GlobalNumElements ; module procedure &
+	 GlobalNumElements_ 
+    end interface
+
+    interface ComputeSparsity ; module procedure &
+	 ComputeSparsitySP_,  &
+	 ComputeSparsityDP_ 
+    end interface
+
+    interface local_row_range ; module procedure &
+	 local_row_range_ 
+    end interface
+
+    interface global_row_range ; module procedure &
+	 global_row_range_ 
+    end interface
+
+    interface local_col_range ; module procedure &
+	 local_col_range_ 
+    end interface
+
+    interface global_col_range ; module procedure &
+	 global_col_range_ 
+    end interface
+
+    interface CheckBounds; module procedure &
+	 CheckBounds_ 
+    end interface
+
+    interface row_sum ; module procedure &
+	 row_sumSP_, &
+	 row_sumDP_
+    end interface
+
+    interface row_sum_check ; module procedure &
+	 row_sum_checkSP_, & 
+	 row_sum_checkDP_
+    end interface
+
+    interface Sort ; module procedure Sort_ ; end interface
+    interface Permute ; module procedure Permute_ ; end interface
+    interface SortPermute ; module procedure SortPermute_ ; end interface
+
+! !REVISION HISTORY:
+! 19Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 15Jan01 - J.W. Larson <larson@mcs.anl.gov> - added numerous APIs
+! 25Feb01 - J.W. Larson <larson@mcs.anl.gov> - changed from row/column
+!           attributes to global and local row and column attributes
+! 23Apr01 - J.W. Larson <larson@mcs.anl.gov> - added number of rows
+!           and columns to the SparseMatrix type.  This means the
+!           SparseMatrix is no longer a straight AttrVect type.  This
+!           also made necessary the addition of lsize(), indexIA(),
+!           and indexRA().
+! 29Oct03 - R. Jacob <jacob@mcs.anl.gov> - extend the SparseMatrix type
+!           to include mods from Fujitsu for a vector-friendly MatVecMul
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SparseMatrix'
+
+! SparseMatrix_iList components:
+  character(len=*),parameter :: SparseMatrix_iList='grow:gcol:lrow:lcol'
+  integer,parameter :: SparseMatrix_igrow=1
+  integer,parameter :: SparseMatrix_igcol=2
+  integer,parameter :: SparseMatrix_ilrow=3
+  integer,parameter :: SparseMatrix_ilcol=4
+
+! SparseMatrix_rList components:
+  character(len=*),parameter :: SparseMatrix_rList='weight'
+  integer,parameter :: SparseMatrix_iweight=1
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Initialize an Empty SparseMatrix
+!
+! !DESCRIPTION:  This routine creates the storage space for the
+! entries of a {\tt SparseMatrix}, and sets the number of rows and
+! columns in it.  The input {\tt INTEGER} arguments {\tt nrows} and 
+! {\tt ncols} specify the number of rows and columns respectively.
+! The optional input argument {\tt lsize} specifies the number of 
+! nonzero entries in the {\tt SparseMatrix}.  The initialized 
+! {\tt SparseMatrix} is returned in the output argument {\tt sMat}.
+!
+! {\bf N.B.}:  This routine is allocating dynamical memory in the form
+! of a {\tt SparseMatrix}.  The user must deallocate this space when
+! the {\tt SparseMatrix} is no longer needed by invoking the routine
+! {\tt clean\_()}.
+!
+! !INTERFACE:
+
+ subroutine init_(sMat, nrows, ncols, lsize)
+!
+! !USES:
+!
+      use m_AttrVect, only : AttrVect_init => init
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      integer,            intent(in)   :: nrows
+      integer,            intent(in)   :: ncols
+      integer, optional,  intent(in)   :: lsize
+
+! !OUTPUT PARAMETERS:
+
+      type(SparseMatrix), intent(out)  :: sMat
+
+! !REVISION HISTORY:
+! 19Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - added arguments
+!           nrows and ncols--number of rows and columns in the
+!           SparseMatrix
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::init_'
+
+  integer :: n
+
+        ! if lsize is present, use it to set n; if not, set n=0
+
+  n = 0
+  if(present(lsize)) n=lsize
+
+        ! Initialize number of rows and columns:
+
+  sMat%nrows = nrows
+  sMat%ncols = ncols
+
+        ! Initialize sMat%data using AttrVect_init
+
+  call AttrVect_init(sMat%data, SparseMatrix_iList, &
+                     SparseMatrix_rList, n)
+
+  ! vecinit is off by default
+  sMat%vecinit = .FALSE.
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: vecinit_ - Initialize vector parts of a SparseMatrix
+!
+! !DESCRIPTION:  This routine creates the storage space for 
+! and intializes the vector parts of a {\tt SparseMatrix}.
+!
+! {\bf N.B.}:  This routine assumes the locally indexed parts of a
+! {\tt SparseMatrix} have been initialized.  This is
+! accomplished by either importing the values directly with
+! {\tt importLocalRowIndices} and {\tt importLocalColIndices} or by
+! importing the Global Row and Col Indices and making two calls to 
+! {\tt GlobalToLocalMatrix}.
+!
+! {\bf N.B.}:   The vector portion can use a large amount of
+! memory so it is highly recommended that this routine only
+! be called on a {\tt SparseMatrix} that has been scattered
+! or otherwise sized locally.
+!
+! !INTERFACE:
+
+ subroutine vecinit_(sMat)
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(SparseMatrix), intent(inout)  :: sMat
+
+! !REVISION HISTORY:
+! 27Oct03 - R. Jacob <jacob@mcs.anl.gov> - initial version
+!           using code provided by Yoshi et. al.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::vecinit_'
+
+  integer :: irow,icol,iwgt
+  integer :: num_elements
+  integer :: row,col
+  integer :: ier,l,n
+  integer, dimension(:)  , allocatable :: nr, rn
+
+  if(sMat%vecinit) then
+   write(stderr,'(2a)') myname_, &
+     'MCTERROR:  sMat vector parts have already been initialized...Continuing'
+     RETURN
+  endif
+
+  write(6,*) myname_,'Initializing vecMat'
+  irow = indexIA_(sMat,'lrow',dieWith=myname_)
+  icol = indexIA_(sMat,'lcol',dieWith=myname_)
+  iwgt = indexRA_(sMat,'weight',dieWith=myname_)
+
+  num_elements = lsize_(sMat)
+
+  sMat%row_min = sMat%data%iAttr(irow,1)
+  sMat%row_max = sMat%row_min
+  do n=1,num_elements
+     row = sMat%data%iAttr(irow,n)
+     if ( row > sMat%row_max ) sMat%row_max = row
+     if ( row < sMat%row_min ) sMat%row_min = row
+  enddo
+
+  allocate( nr(sMat%row_max), rn(num_elements), stat=ier)
+  if(ier/=0) call die(myname_,'allocate(nr,rn)',ier)
+
+  sMat%tbl_end = 0
+  nr(:) = 0
+  do n=1,num_elements
+     row = sMat%data%iAttr(irow,n)
+     nr(row) = nr(row)+1
+     rn(n)   = nr(row)
+  enddo
+  sMat%tbl_end = maxval(rn)
+
+  allocate( sMat%tcol(sMat%row_max,sMat%tbl_end),  &
+            sMat%twgt(sMat%row_max,sMat%tbl_end), stat=ier )
+  if(ier/=0) call die(myname_,'allocate(tcol,twgt)',ier)
+
+!CDIR COLLAPSE
+  sMat%tcol(:,:) = -1
+  do n=1,num_elements
+     row = sMat%data%iAttr(irow,n)
+     sMat%tcol(row,rn(n)) = sMat%data%iAttr(icol,n)
+     sMat%twgt(row,rn(n)) = sMat%data%rAttr(iwgt,n)
+  enddo
+
+  allocate( sMat%row_s(sMat%tbl_end) , sMat%row_e(sMat%tbl_end), &
+              stat=ier )
+  if(ier/=0) call die(myname_,'allocate(row_s,row_e',ier)
+  sMat%row_s = sMat%row_min
+  sMat%row_e = sMat%row_max
+  do l=1,sMat%tbl_end
+    do n=sMat%row_min,sMat%row_max
+      if (nr(n) >= l) then
+        sMat%row_s(l) = n
+        exit
+      endif
+    enddo
+    do n = sMat%row_max,sMat%row_min,-1
+      if (nr(n) >= l) then
+        sMat%row_e(l) = n
+        exit
+      endif
+    enddo
+  enddo
+
+  deallocate(nr,rn, stat=ier)
+  if(ier/=0) call die(myname_,'deallocate()',ier)
+
+  sMat%vecinit = .TRUE.
+
+ end subroutine vecinit_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destroy a SparseMatrix.
+!
+! !DESCRIPTION:  This routine deallocates dynamical memory held by the
+! input {\tt SparseMatrix} argument {\tt sMat}.  It also sets the number
+! of rows and columns in the {\tt SparseMatrix} to zero.
+!
+! !INTERFACE:
+
+    subroutine clean_(sMat,stat)
+!
+! !USES:
+!
+      use m_AttrVect,only : AttrVect_clean => clean
+      use m_die
+
+      implicit none
+
+! !INPUT/OUTPTU PARAMETERS:
+
+      type(SparseMatrix), intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      integer, optional,  intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 19Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+! 23Apr00 - J.W. Larson <larson@mcs.anl.gov> - added changes to
+!           accomodate clearing nrows and ncols.
+! 01Mar02 - E.T. Ong <eong@mcs.anl.gov> Added stat argument.
+! 03Oct03 - R. Jacob <jacob@mcs.anl.gov> - clean vector parts
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+       ! Deallocate memory held by sMat:
+
+  if(present(stat)) then
+     call AttrVect_clean(sMat%data,stat)
+  else
+     call AttrVect_clean(sMat%data)
+  endif
+
+       ! Set the number of rows and columns in sMat to zero:
+
+  sMat%nrows = 0
+  sMat%ncols = 0
+
+  if(sMat%vecinit) then
+    sMat%row_max = 0
+    sMat%row_min = 0
+    sMat%tbl_end = 0
+    deallocate(sMat%row_s,sMat%row_e,stat=ier)
+    if(ier/=0) then
+      if(present(stat)) then
+        stat=ier
+      else
+        call warn(myname_,'deallocate(row_s,row_e)',ier)
+      endif
+    endif
+
+    deallocate(sMat%tcol,sMat%twgt,stat=ier)
+    if(ier/=0) then
+      if(present(stat)) then
+        stat=ier
+      else
+        call warn(myname_,'deallocate(tcol,twgt)',ier)
+      endif
+    endif
+    sMat%vecinit = .FALSE.
+  endif
+   
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: lsize_ - Local Number Non-zero Elements
+!
+! !DESCRIPTION:  This {\tt INTEGER} function reports on-processor storage 
+! of the number of nonzero elements in the input {\tt SparseMatrix} 
+! argument {\tt sMat}.  
+!
+! !INTERFACE:
+
+    integer function lsize_(sMat)
+!
+! !USES:
+!
+      use m_AttrVect,only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in) :: sMat
+
+! !REVISION HISTORY:
+! 23Apr00 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::lsize_'
+
+  lsize_ = AttrVect_lsize(sMat%data)
+
+ end function lsize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE:  GlobalNumElements_ - Global Number of Non-zero Elements
+!
+! !DESCRIPTION:  This routine computes the number of nonzero elements 
+! in a distributed {\tt SparseMatrix} variable {\tt sMat}.  The input 
+! {\tt SparseMatrix} argument {\tt sMat} is examined on each process 
+! to determine the number of nonzero elements it holds, and this value 
+! is summed across the communicator associated with the input 
+! {\tt INTEGER} handle {\tt comm}, with the total returned {\em on each
+! process on the communicator}.
+!
+! !INTERFACE:
+
+ integer function GlobalNumElements_(sMat, comm)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer, optional,  intent(in)  :: comm
+
+! !REVISION HISTORY:
+! 24Apr01 - Jay Larson <larson@mcs.anl.gov> - New routine.
+!
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//':: GlobalNumElements_'
+
+  integer :: MyNumElements, GNumElements, ierr
+
+       ! Determine the number of locally held nonzero elements:
+
+  MyNumElements = lsize_(sMat)
+
+  call MPI_ALLREDUCE(MyNumElements, GNumElements, 1, MP_INTEGER, &
+                     MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_ALLREDUCE(MyNumElements...",ierr)
+  endif
+
+ GlobalNumElements_ = GNumElements
+
+ end function GlobalNumElements_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexIA_ - Index an Integer Attribute
+!
+! !DESCRIPTION:  This {\tt INTEGER} function reports the row index 
+! for a given {\tt INTEGER} attribute of the input {\tt SparseMatrix} 
+! argument {\tt sMat}.  The attribute requested is represented by the 
+! input {\tt CHARACTER} variable {\tt attribute}.  The list of integer 
+! attributes one can request is defined in the description block of the 
+! header of this module ({\tt m\_SparseMatrix}).
+!
+! Here is how {\tt indexIA\_} provides access to integer attribute data
+! in a {\tt SparseMatrix} variable {\tt sMat}.  Suppose we wish to access
+! global row information.  This attribute has associated with it the 
+! string tag {\tt grow}.  The corresponding index returned ({\tt igrow}) 
+! is determined by invoking {\tt indexIA\_}:
+! \begin{verbatim}
+! igrow = indexIA_(sMat, 'grow')
+! \end{verbatim}
+!
+! Access to the global row index data in {\tt sMat} is thus obtained by 
+! referencing {\tt sMat\%data\%iAttr(igrow,:)}.
+!
+!
+! !INTERFACE:
+
+    integer function indexIA_(sMat, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      use m_AttrVect,only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix),         intent(in) :: sMat
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+!       23Apr00 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexIA_'
+  type(String) :: myTrace
+
+       ! Generate a traceback String
+
+  if(present(dieWith)) then
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then
+        call GenTraceBackString(myTrace, perrWith, myname_)
+     else
+        call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Call AttrVect_indexIA() accordingly:
+
+  if( present(dieWith) .or. &
+     ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
+     indexIA_ = AttrVect_indexIA(sMat%data, item, &
+                                 dieWith=String_ToChar(myTrace))
+  else  ! perrWith but no dieWith case
+     indexIA_ = AttrVect_indexIA(sMat%data, item, &
+                   perrWith=String_ToChar(myTrace))
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexIA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexRA_ - Index a Real Attribute
+!
+! !DESCRIPTION:  This {\tt INTEGER} function reports the row index 
+! for a given {\tt REAL} attribute of the input {\tt SparseMatrix} 
+! argument {\tt sMat}.  The attribute requested is represented by the 
+! input {\tt CHARACTER} variable {\tt attribute}.  The list of real 
+! attributes one can request is defined in the description block of the 
+! header of this module ({\tt m\_SparseMatrix}).
+!
+! Here is how {\tt indexRA\_} provides access to integer attribute data
+! in a {\tt SparseMatrix} variable {\tt sMat}.  Suppose we wish to access
+! matrix element values.  This attribute has associated with it the 
+! string tag {\tt weight}.  The corresponding index returned ({\tt iweight}) 
+! is determined by invoking {\tt indexRA\_}:
+! \begin{verbatim}
+! iweight = indexRA_(sMat, 'weight')
+! \end{verbatim}
+!
+! Access to the matrix element data in {\tt sMat} is thus obtained by 
+! referencing {\tt sMat\%data\%rAttr(iweight,:)}.
+!
+! !INTERFACE:
+
+    integer function indexRA_(sMat, item, perrWith, dieWith)
+!
+! !USES:
+!
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_clean => clean
+      use m_String, only : String_ToChar => ToChar
+
+      use m_TraceBack, only : GenTraceBackString
+
+      use m_AttrVect,only : AttrVect_indexRA => indexRA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix),         intent(in) :: sMat
+      character(len=*),           intent(in) :: item
+      character(len=*), optional, intent(in) :: perrWith
+      character(len=*), optional, intent(in) :: dieWith
+
+! !REVISION HISTORY:
+! 24Apr00 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexRA_'
+
+  type(String) :: myTrace
+
+       ! Generate a traceback String
+
+  if(present(dieWith)) then ! append myname_ onto dieWith
+     call GenTraceBackString(myTrace, dieWith, myname_)
+  else
+     if(present(perrWith)) then ! append myname_ onto perrwith
+        call GenTraceBackString(myTrace, perrWith, myname_)
+     else ! Start a TraceBack String
+        call GenTraceBackString(myTrace, myname_)
+     endif
+  endif
+
+       ! Call AttrVect_indexRA() accordingly:
+
+  if( present(dieWith) .or. &
+     ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
+     indexRA_ = AttrVect_indexRA(sMat%data, item, &
+                                 dieWith=String_ToChar(myTrace))
+  else  ! perrWith but no dieWith case
+     indexRA_ = AttrVect_indexRA(sMat%data, item, &
+                   perrWith=String_ToChar(myTrace))
+  endif
+
+  call String_clean(myTrace)
+
+ end function indexRA_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nRows_ - Return the Number of Rows
+!
+! !DESCRIPTION:  This routine returns the {\em total} number of rows
+! in the input {\tt SparseMatrix} argument {\tt sMat}.  This number of
+! rows is a constant, and not dependent on the decomposition of the 
+! {\tt SparseMatrix}.
+!
+! !INTERFACE:
+
+    integer function nRows_(sMat)
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in) :: sMat
+
+! !REVISION HISTORY:
+! 19Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nRows_'
+
+  nRows_ = sMat%nrows
+
+ end function nRows_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nCols_ - Return the Number of Columns
+!
+! !DESCRIPTION:  This routine returns the {\em total} number of columns
+! in the input {\tt SparseMatrix} argument {\tt sMat}.  This number of
+! columns is a constant, and not dependent on the decomposition of the 
+! {\tt SparseMatrix}.
+!
+! !INTERFACE:
+
+    integer function nCols_(sMat)
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in) :: sMat
+
+! !REVISION HISTORY:
+! 19Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nCols_'
+
+  nCols_ = sMat%ncols
+
+ end function nCols_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportGlobalRowIndices_ - Return Global Row Indices
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt SparseMatrix} argument 
+! {\tt sMat} its global row indices, and returns them in the {\tt INTEGER} 
+! output array {\tt GlobalRows}, and its length in the output {\tt INTEGER} 
+! argument {\tt length}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt GlobalRows} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt GlobalRows},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt GlobalRows}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportGlobalRowIndices_(sMat, GlobalRows, length)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: GlobalRows
+      integer,  optional,     intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportGlobalRowIndices_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportIAttr(sMat%data, 'grow', GlobalRows, length)
+  else
+     call AttrVect_exportIAttr(sMat%data, 'grow', GlobalRows)
+  endif
+
+ end subroutine exportGlobalRowIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportGlobalColumnIndices_ - Return Global Column Indices
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt SparseMatrix} argument 
+! {\tt sMat} its global column indices, and returns them in the {\tt INTEGER} 
+! output array {\tt GlobalColumns}, and its length in the output {\tt INTEGER} 
+! argument {\tt length}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt GlobalColumns} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt GlobalColumns},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt GlobalColumns}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportGlobalColumnIndices_(sMat, GlobalColumns, length)
+
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: GlobalColumns
+      integer,  optional,     intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportGlobalColumnIndices_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportIAttr(sMat%data, 'gcol', GlobalColumns, length)
+  else
+     call AttrVect_exportIAttr(sMat%data, 'gcol', GlobalColumns)
+  endif
+
+ end subroutine exportGlobalColumnIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportLocalRowIndices_ - Return Local Row Indices
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt SparseMatrix} argument 
+! {\tt sMat} its local row indices, and returns them in the {\tt INTEGER} 
+! output array {\tt LocalRows}, and its length in the output {\tt INTEGER} 
+! argument {\tt length}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt LocalRows} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt LocalRows},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt LocalRows}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportLocalRowIndices_(sMat, LocalRows, length)
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: LocalRows
+      integer,  optional,     intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportLocalRowIndices_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportIAttr(sMat%data, 'lrow', LocalRows, length)
+  else
+     call AttrVect_exportIAttr(sMat%data, 'lrow', LocalRows)
+  endif
+
+ end subroutine exportLocalRowIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportLocalColumnIndices_ - Return Local Column Indices 
+!
+! !DESCRIPTION:
+! This routine extracts from the input {\tt SparseMatrix} argument 
+! {\tt sMat} its local column indices, and returns them in the {\tt INTEGER} 
+! output array {\tt LocalColumns}, and its length in the output {\tt INTEGER} 
+! argument {\tt length}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt LocalColumns} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt LocalColumns},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt LocalColumns}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine exportLocalColumnIndices_(sMat, LocalColumns, length)
+
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_exportIAttr => exportIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer     :: LocalColumns
+      integer,  optional,     intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportLocalColumnIndices_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportIAttr(sMat%data, 'lcol', LocalColumns, length)
+  else
+     call AttrVect_exportIAttr(sMat%data, 'lcol', LocalColumns)
+  endif
+
+ end subroutine exportLocalColumnIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportMatrixElementsSP_ - Return Matrix Elements as Array
+!
+! !DESCRIPTION:
+! This routine extracts the matrix elements from the input {\tt SparseMatrix} 
+! argument {\tt sMat}, and returns them in the {\tt REAL} output array 
+! {\tt MatrixElements}, and its length in the output {\tt INTEGER} 
+! argument {\tt length}.
+!
+! {\bf N.B.:}  The flexibility of this routine regarding the pointer 
+! association status of the output argument {\tt MatrixElements} means the
+! user must invoke this routine with care.  If the user wishes this
+! routine to fill a pre-allocated array, then obviously this array
+! must be allocated prior to calling this routine.  If the user wishes
+! that the routine {\em create} the output argument array {\tt MatrixElements},
+! then the user must ensure this pointer is not allocated (i.e. the user
+! must nullify this pointer) at the time this routine is invoked.
+!
+! {\bf N.B.:}  If the user has relied on this routine to allocate memory
+! associated with the pointer {\tt MatrixElements}, then the user is responsible 
+! for deallocating this array once it is no longer needed.  Failure to 
+! do so will result in a memory leak.
+!
+! The native precision version is described here.  A double precision version
+! is also available.
+!
+! !INTERFACE:
+
+ subroutine exportMatrixelementsSP_(sMat, MatrixElements, length)
+
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+      use m_realkinds, only : SP
+
+      use m_AttrVect,      only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      real(SP),  dimension(:),    pointer     :: MatrixElements
+      integer,   optional,        intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!  6Jan04 - R. Jacob <jacob@mcs.anl.gov> - SP and DP versions
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportMatrixElementsSP_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportRAttr(sMat%data, 'weight', MatrixElements, length)
+  else
+     call AttrVect_exportRAttr(sMat%data, 'weight', MatrixElements)
+  endif
+
+ end subroutine exportMatrixElementsSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: exportMatrixElementsDP_ - Return Matrix Elements as Array
+!
+! !DESCRIPTION:
+! Double precision version of exportMatrixElementsSP_
+!
+! !INTERFACE:
+
+ subroutine exportMatrixelementsDP_(sMat, MatrixElements, length)
+
+!
+! !USES:
+!
+      use m_die 
+      use m_stdio
+      use m_realkinds, only : DP
+
+      use m_AttrVect,      only : AttrVect_exportRAttr => exportRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      real(DP),  dimension(:),    pointer     :: MatrixElements
+      integer,   optional,        intent(out) :: length
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+!
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportMatrixElementsDP_'
+
+       ! Export the data (inheritance from AttrVect)
+  if(present(length)) then
+     call AttrVect_exportRAttr(sMat%data, 'weight', MatrixElements, length)
+  else
+     call AttrVect_exportRAttr(sMat%data, 'weight', MatrixElements)
+  endif
+
+ end subroutine exportMatrixElementsDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importGlobalRowIndices_ - Set Global Row Indices of Elements
+!
+! !DESCRIPTION:
+! This routine imports global row index data into the {\tt SparseMatrix} 
+! argument {\tt sMat}.  The user provides the index data in the input 
+! {\tt INTEGER} vector {\tt inVect}.  The input {\tt INTEGER} argument 
+! {\tt lsize} is used as a consistencey check to ensure the user is
+! sufficient space in the {\tt SparseMatrix} to store the data.
+!
+! !INTERFACE:
+
+ subroutine importGlobalRowIndices_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importGlobalRowIndices_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(sMat%data, 'grow', inVect, lsize)
+
+ end subroutine importGlobalRowIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importGlobalColumnIndices_ - Set Global Column Indices of Elements
+!
+! !DESCRIPTION:
+! This routine imports global column index data into the {\tt SparseMatrix} 
+! argument {\tt sMat}.  The user provides the index data in the input 
+! {\tt INTEGER} vector {\tt inVect}.  The input {\tt INTEGER} argument 
+! {\tt lsize} is used as a consistencey check to ensure the user is
+! sufficient space in the {\tt SparseMatrix} to store the data.
+!
+! !INTERFACE:
+
+ subroutine importGlobalColumnIndices_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importGlobalColumnIndices_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(sMat%data, 'gcol', inVect, lsize)
+
+ end subroutine importGlobalColumnIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importLocalRowIndices_ - Set Local Row Indices of Elements
+!
+! !DESCRIPTION:
+! This routine imports local row index data into the {\tt SparseMatrix} 
+! argument {\tt sMat}.  The user provides the index data in the input 
+! {\tt INTEGER} vector {\tt inVect}.  The input {\tt INTEGER} argument 
+! {\tt lsize} is used as a consistencey check to ensure the user is
+! sufficient space in the {\tt SparseMatrix} to store the data.
+!
+! !INTERFACE:
+
+ subroutine importLocalRowIndices_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importLocalRowIndices_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(sMat%data, 'lrow', inVect, lsize)
+
+ end subroutine importLocalRowIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importLocalColumnIndices_ - Set Local Column Indices of Elements
+!
+! !DESCRIPTION:
+! This routine imports local column index data into the {\tt SparseMatrix} 
+! argument {\tt sMat}.  The user provides the index data in the input 
+! {\tt INTEGER} vector {\tt inVect}.  The input {\tt INTEGER} argument 
+! {\tt lsize} is used as a consistencey check to ensure the user is
+! sufficient space in the {\tt SparseMatrix} to store the data.
+!
+! !INTERFACE:
+
+ subroutine importLocalColumnIndices_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect_importIAttr => importIAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      integer,  dimension(:), pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importLocalColumnIndices_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importIAttr(sMat%data, 'lcol', inVect, lsize)
+
+ end subroutine importLocalColumnIndices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: importMatrixElementsSP_ - Import Non-zero Matrix Elements
+!
+! !DESCRIPTION:
+! This routine imports matrix elements index data into the 
+! {\tt SparseMatrix} argument {\tt sMat}.  The user provides the index 
+! data in the input {\tt REAL} vector {\tt inVect}.  The input 
+! {\tt INTEGER} argument {\tt lsize} is used as a consistencey check 
+! to ensure the user is sufficient space in the {\tt SparseMatrix} 
+! to store the data.
+!
+! !INTERFACE:
+
+ subroutine importMatrixElementsSP_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+      use m_realkinds, only : SP
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      real(SP),  dimension(:),    pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!  6Jan04 - R. Jacob <jacob@mcs.anl.gov> - Make SP and DP versions.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importMatrixElementsSP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(sMat%data, 'weight', inVect, lsize)
+
+ end subroutine importMatrixElementsSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: importMatrixElementsDP_ - Import Non-zero Matrix Elements
+!
+! !DESCRIPTION:
+! Double precision version of importMatrixElementsSP_
+!
+! !INTERFACE:
+
+ subroutine importMatrixElementsDP_(sMat, inVect, lsize)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+      use m_realkinds, only : DP
+
+      use m_AttrVect,      only : AttrVect_importRAttr => importRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      real(DP),  dimension(:),    pointer       :: inVect
+      integer,                intent(in)    :: lsize
+
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !REVISION HISTORY:
+!  7May02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::importMatrixElementsDP_'
+
+       ! Argument Check:
+
+  if(lsize > lsize_(sMat)) then
+     write(stderr,*) myname_,':: ERROR, lsize > lsize_(sMat).', &
+          'lsize = ',lsize,'lsize_(sMat) = ',lsize_(sMat)
+     call die(myname_)
+  endif
+
+       ! Import the data (inheritance from AttrVect)
+
+  call AttrVect_importRAttr(sMat%data, 'weight', inVect, lsize)
+
+ end subroutine importMatrixElementsDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Copy_ - Create a Copy of an Input SparseMatrix
+!
+! !DESCRIPTION:
+! This routine creates a copy of the input {\tt SparseMatrix} argument 
+! {\tt sMat}, returning it as the output {\tt SparseMatrix} argument 
+! {\tt sMatCopy}.
+!
+! {\bf N.B.:}  The output argument {\tt sMatCopy} represents allocated 
+! memory the user must deallocate when it is no longer needed.  The 
+! MCT routine to use for this purpose is {\tt clean()} from this module.
+!
+! !INTERFACE:
+
+ subroutine Copy_(sMat, sMatCopy)
+
+!
+! !USES:
+!
+      use m_die
+      use m_stdio
+
+      use m_AttrVect,      only : AttrVect
+      use m_AttrVect,      only : AttrVect_init => init
+      use m_AttrVect,      only : AttrVect_lsize => lsize
+      use m_AttrVect,      only : AttrVect_Copy => Copy
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix), intent(in) :: sMat
+
+! !OUTPUT PARAMETERS: 
+
+      type(SparseMatrix), intent(out) :: sMatCopy
+
+! !REVISION HISTORY:
+! 27Sep02 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Copy_'
+
+       ! Step one:  copy the integer components of sMat:
+
+  sMatCopy%nrows = sMat%nrows
+  sMatCopy%ncols = sMat%ncols
+
+  sMatCopy%vecinit = .FALSE.
+
+       ! Step two:  Initialize the AttrVect sMatCopy%data off of sMat:
+
+  call AttrVect_init(sMatCopy%data, sMat%data, AttrVect_lsize(sMat%data))
+
+       ! Step three:  Copy sMat%data to sMatCopy%data:
+
+  call AttrVect_Copy(sMat%data, aVout=sMatCopy%data)
+
+  if(sMat%vecinit) call vecinit_(sMatCopy)
+
+ end subroutine Copy_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: local_row_range_ - Local Row Extent of Non-zero Elements
+!
+! !DESCRIPTION: This routine examines the input distributed 
+! {\tt SparseMatrix} variable {\tt sMat}, and returns the range of local 
+! row values having nonzero elements.  The first local row with 
+! nonzero elements is returned in the {\tt INTEGER} argument 
+! {\tt start\_row}, the last row in {\tt end\_row}.
+!
+! !INTERFACE:
+
+ subroutine local_row_range_(sMat, start_row, end_row)
+!
+! !USES:
+!
+      use m_die
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: start_row
+      integer,            intent(out) :: end_row
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Initial prototype.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::local_row_range_'
+
+  integer :: i, ilrow, lsize
+
+  ilrow = AttrVect_indexIA(sMat%data, 'lrow')
+  lsize = AttrVect_lsize(sMat%data)
+
+       ! Initialize start_row and end_row:
+
+  start_row = sMat%data%iAttr(ilrow,1)
+  end_row = sMat%data%iAttr(ilrow,1)
+
+  do i=1,lsize
+     start_row = min(start_row, sMat%data%iAttr(ilrow,i))
+     end_row = max(end_row, sMat%data%iAttr(ilrow,i))
+  end do
+
+ end subroutine local_row_range_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: global_row_range_ - Global Row Extent of Non-zero Elements
+!
+! !DESCRIPTION:  This routine examines the input distributed 
+! {\tt SparseMatrix} variable {\tt sMat}, and returns the range of 
+! global row values having nonzero elements.  The first local row with 
+! nonzero elements is returned in the {\tt INTEGER} argument 
+! {\tt start\_row}, the last row in {\tt end\_row}. 
+!
+! !INTERFACE:
+
+ subroutine global_row_range_(sMat, comm, start_row, end_row)
+!
+! !USES:
+!
+      use m_die
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: start_row
+      integer,            intent(out) :: end_row
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Initial prototype.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::global_row_range_'
+
+  integer :: i, igrow, lsize
+
+  igrow = AttrVect_indexIA(sMat%data, 'grow', dieWith=myname_)
+  lsize = AttrVect_lsize(sMat%data)
+
+       ! Initialize start_row and end_row:
+
+  start_row = sMat%data%iAttr(igrow,1)
+  end_row = sMat%data%iAttr(igrow,1)
+
+  do i=1,lsize
+     start_row = min(start_row, sMat%data%iAttr(igrow,i))
+     end_row = max(end_row, sMat%data%iAttr(igrow,i))
+  end do
+
+ end subroutine global_row_range_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: local_col_range_ - Local Column Extent of Non-zero Elements
+!
+! !DESCRIPTION: This routine examines the input distributed 
+! {\tt SparseMatrix} variable {\tt sMat}, and returns the range of
+! local column values having nonzero elements.  The first local column 
+! with nonzero elements is returned in the {\tt INTEGER} argument 
+! {\tt start\_col}, the last column in {\tt end\_col}.
+!
+! !INTERFACE:
+
+ subroutine local_col_range_(sMat, start_col, end_col)
+!
+! !USES:
+!
+      use m_die
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: start_col
+      integer,            intent(out) :: end_col
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Initial prototype.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::local_col_range_'
+
+  integer :: i, ilcol, lsize
+
+  ilcol = AttrVect_indexIA(sMat%data, 'lcol')
+  lsize = AttrVect_lsize(sMat%data)
+
+       ! Initialize start_col and end_col:
+
+  start_col = sMat%data%iAttr(ilcol,1)
+  end_col = sMat%data%iAttr(ilcol,1)
+
+  do i=1,lsize
+     start_col = min(start_col, sMat%data%iAttr(ilcol,i))
+     end_col = max(end_col, sMat%data%iAttr(ilcol,i))
+  end do
+
+ end subroutine local_col_range_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: global_col_range_ - Global Column Extent of Non-zero Elements
+!
+! !DESCRIPTION:  This routine examines the input distributed 
+! {\tt SparseMatrix} variable {\tt sMat}, and returns the range of 
+! global column values having nonzero elements.  The first global 
+! column with nonzero elements is returned in the {\tt INTEGER} argument 
+! {\tt start\_col}, the last column in {\tt end\_col}.  
+!
+! !INTERFACE:
+
+ subroutine global_col_range_(sMat, comm, start_col, end_col)
+!
+! !USES:
+!
+      use m_die
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: start_col
+      integer,            intent(out) :: end_col
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Initial prototype.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::global_col_range_'
+
+  integer :: i, igcol, lsize
+
+  igcol = AttrVect_indexIA(sMat%data, 'gcol')
+  lsize = AttrVect_lsize(sMat%data)
+
+       ! Initialize start_col and end_col:
+
+  start_col = sMat%data%iAttr(igcol,1)
+  end_col = sMat%data%iAttr(igcol,1)
+
+  do i=1,lsize
+     start_col = min(start_col, sMat%data%iAttr(igcol,i))
+     end_col = max(end_col, sMat%data%iAttr(igcol,i))
+  end do
+
+ end subroutine global_col_range_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ComputeSparsitySP_ - Compute Matrix Sparsity
+!
+! !DESCRIPTION:  This routine computes the sparsity of a consolidated
+! (all on one process) or distributed {\tt SparseMatrix}.  The input 
+! {\tt SparseMatrix} argument {\tt sMat} is examined to determine the
+! number of nonzero elements it holds, and this value is divided by the
+! product of the number of rows and columns in {\tt sMat}.  If the 
+! optional input argument {\tt comm} is given, then the distributed 
+! elements are counted and the sparsity computed accordingly, and the 
+! resulting value of {\tt sparsity} is returned {\em to all processes}.
+!
+! Given the inherent problems with multiplying and dividing large integers,
+! the work in this routine is performed using floating point arithmetic on
+! the logarithms of the number of rows, columns, and nonzero elements.
+!
+! !INTERFACE:
+
+ subroutine ComputeSparsitySP_(sMat, sparsity, comm)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer, optional,  intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      real(SP),           intent(out) :: sparsity
+
+! !REVISION HISTORY:
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - New routine.
+!
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::ComputeSparsitySP_'
+
+  integer  :: num_elements, num_rows, num_cols
+  real(FP) :: Lnum_elements, Lnum_rows, Lnum_cols, LMySparsity
+  real(FP) :: MySparsity
+  integer  :: ierr
+
+       ! Extract number of nonzero elements and compute its logarithm
+
+  num_elements = lsize_(sMat)
+  Lnum_elements = log(REAL(num_elements,FP))
+
+       ! Extract number of rows and compute its logarithm
+
+  num_rows = nRows_(sMat)
+  Lnum_rows = log(REAL(num_rows,FP))
+
+       ! Extract number of columns and compute its logarithm
+
+  num_cols = nCols_(sMat)
+  Lnum_cols = log(REAL(num_cols,FP))  
+
+       ! Compute logarithm of the (local) sparsity
+
+  LMySparsity = Lnum_elements - Lnum_rows - Lnum_cols
+
+       ! Compute the (local) sparsity from its logarithm.
+
+  MySparsity = exp(LMySparsity)
+
+       ! If a communicator handle is present, sum up the
+       ! distributed sparsity values to all processes.  If not,
+       ! return the value of MySparsity computed above.
+
+  if(present(comm)) then
+     call MPI_ALLREDUCE(MySparsity, sparsity, 1, MP_INTEGER, &
+                        MP_SUM, comm, ierr)
+     if(ierr /= 0) then
+	call MP_perr_die(myname_,"MPI_ALLREDUCE(MySparsity...",ierr)
+     endif
+  else
+     sparsity = MySparsity
+  endif
+
+ end subroutine ComputeSparsitySP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: ComputeSparsityDP_ - Compute Matrix Sparsity
+!
+! !DESCRIPTION:
+! Double precision version of ComputeSparsitySP_
+!
+! !INTERFACE:
+
+ subroutine ComputeSparsityDP_(sMat, sparsity, comm)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer, optional,  intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      real(DP),           intent(out) :: sparsity
+
+! !REVISION HISTORY:
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - New routine.
+!
+! ______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::ComputeSparsityDP_'
+
+  integer  :: num_elements, num_rows, num_cols
+  real(FP) :: Lnum_elements, Lnum_rows, Lnum_cols, LMySparsity
+  real(FP) :: MySparsity
+  integer  :: ierr
+
+       ! Extract number of nonzero elements and compute its logarithm
+
+  num_elements = lsize_(sMat)
+  Lnum_elements = log(REAL(num_elements,FP))
+
+       ! Extract number of rows and compute its logarithm
+
+  num_rows = nRows_(sMat)
+  Lnum_rows = log(REAL(num_rows,FP))
+
+       ! Extract number of columns and compute its logarithm
+
+  num_cols = nCols_(sMat)
+  Lnum_cols = log(REAL(num_cols,FP))  
+
+       ! Compute logarithm of the (local) sparsity
+
+  LMySparsity = Lnum_elements - Lnum_rows - Lnum_cols
+
+       ! Compute the (local) sparsity from its logarithm.
+
+  MySparsity = exp(LMySparsity)
+
+       ! If a communicator handle is present, sum up the
+       ! distributed sparsity values to all processes.  If not,
+       ! return the value of MySparsity computed above.
+
+  if(present(comm)) then
+     call MPI_ALLREDUCE(MySparsity, sparsity, 1, MP_INTEGER, &
+                        MP_SUM, comm, ierr)
+     if(ierr /= 0) then
+	call MP_perr_die(myname_,"MPI_ALLREDUCE(MySparsity...",ierr)
+     endif
+  else
+     sparsity = MySparsity
+  endif
+
+ end subroutine ComputeSparsityDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: CheckBounds_ - Check for Out-of-Bounds Row/Column Values
+!
+! !DESCRIPTION:  This routine examines the input distributed 
+! {\tt SparseMatrix} variable {\tt sMat}, and examines the global row
+! and column index for each element, comparing them with the known 
+! maximum values for each (as returned by the routines {\tt nRows\_()}
+! and {\tt nCols\_()}, respectively).  If global row or column entries 
+! are non-positive, or greater than the defined maximum values, this
+! routine stops execution with an error message.  If no out-of-bounds
+! values are detected, the output {\tt INTEGER} status {\tt ierror} is 
+! set to zero.
+!
+! !INTERFACE:
+
+ subroutine CheckBounds_(sMat, ierror)
+!
+! !USES:
+!
+      use m_die
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: ierror
+
+! !REVISION HISTORY:
+! 24Apr01 - Jay Larson <larson@mcs.anl.gov> - Initial prototype.
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::CheckBounds_'
+
+  integer :: MaxRow, MaxCol, NumElements
+  integer :: igrow, igcol
+  integer :: i
+
+       ! Initially, set ierror to zero (success):
+
+  ierror = 0
+
+       ! Query sMat to find the number of rows and columns:
+
+  MaxRow = nRows_(sMat)
+  MaxCol = nCols_(sMat)
+
+       ! Query sMat for the number of nonzero elements:
+
+  NumElements = lsize_(sMat)
+
+       ! Query sMat to index global row and column storage indices:
+
+  igrow = indexIA_(sMat=sMat,item='grow',dieWith=myname_)
+  igcol = indexIA_(sMat=sMat,item='gcol',dieWith=myname_)
+
+       ! Scan the entries of sMat for row or column elements that
+       ! are out-of-bounds.  Here, out-of-bounds means:  1) non-
+       ! positive row or column indices; 2) row or column indices
+       ! exceeding the stated number of rows or columns.
+
+  do i=1,NumElements
+
+       ! Row index out of bounds?
+
+     if((sMat%data%iAttr(igrow,i) > MaxRow) .or. &
+	  (sMat%data%iAttr(igrow,i) <= 0)) then
+	ierror = 1
+	call die(myname_,"Row index out of bounds",ierror)
+     endif
+
+       ! Column index out of bounds?
+
+     if((sMat%data%iAttr(igcol,i) > MaxCol) .or. &
+	  (sMat%data%iAttr(igcol,i) <= 0)) then
+	ierror = 2
+	call die(myname_,"Column index out of bounds",ierror)
+     endif
+
+  end do
+
+ end subroutine CheckBounds_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: row_sumSP_ - Sum Elements in Each Row
+!
+! !DESCRIPTION:
+! Given an input {\tt SparseMatrix} argument {\tt sMat}, {\tt row\_sum\_()}
+! returns the number of the rows {\tt num\_rows} in the sparse matrix and
+! the sum of the elements in each row in the array {\tt sums}.  The input
+! argument {\tt comm} is the Fortran 90 MPI communicator handle used to
+! determine the number of rows and perform the sums.  The output arguments
+! {\tt num\_rows} and {\tt sums} are valid on all processes.
+!
+! {\bf N.B.:  } This routine allocates an array {\tt sums}.  The user is
+! responsible for deallocating this array when it is no longer needed.  
+! Failure to do so will cause a memory leak.
+!
+! !INTERFACE:
+
+ subroutine row_sumSP_(sMat, num_rows, sums, comm)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: num_rows
+      real(SP), dimension(:), pointer :: sums
+
+
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Jan01 - Jay Larson <larson@mcs.anl.gov> - Prototype code.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+! 18May01 - R. Jacob <jacob@mcs.anl.gov> - Use MP_TYPE function
+!           to set type in the mpi_allreduce
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::row_sumSP_'
+
+  integer :: i, igrow, ierr, iwgt, lsize, myID
+  integer :: start_row, end_row
+  integer :: mp_Type_lsums
+  real(FP), dimension(:), allocatable :: lsums
+  real(FP), dimension(:), allocatable :: gsums
+
+       ! Determine local rank
+
+  call MP_COMM_RANK(comm, myID, ierr)
+
+       ! Determine on each process the row of global row indices:
+
+  call global_row_range_(sMat, comm, start_row, end_row)
+
+       ! Determine across the communicator the _maximum_ value of
+       ! end_row, which will be assigned to num_rows on each process:
+
+  call MPI_ALLREDUCE(end_row, num_rows, 1, MP_INTEGER, MP_MAX, &
+                    comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_ALLREDUCE(end_row...",ierr)
+  endif
+
+       ! Allocate storage for the sums on each process.
+
+  allocate(lsums(num_rows), gsums(num_rows), sums(num_rows), stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,"allocate(lsums(...",ierr)
+  endif
+
+       ! Compute the local entries to lsum(1:num_rows) for each process:
+
+  lsize = AttrVect_lsize(sMat%data)
+  igrow = AttrVect_indexIA(aV=sMat%data,item='grow',dieWith=myname_)
+  iwgt = AttrVect_indexRA(aV=sMat%data,item='weight',dieWith=myname_)
+
+  lsums = 0._FP
+  do i=1,lsize
+     lsums(sMat%data%iAttr(igrow,i)) = lsums(sMat%data%iAttr(igrow,i)) + &
+	                           sMat%data%rAttr(iwgt,i)
+  end do
+
+       ! Compute the global sum of the entries of lsums so that all
+       ! processes own the global sums.
+
+  mp_Type_lsums=MP_Type(lsums)
+  call MPI_ALLREDUCE(lsums, gsums, num_rows, mp_Type_lsums, MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_ALLREDUCE(lsums...",ierr)
+  endif
+
+       ! Copy our temporary array gsums into the output pointer sums
+       ! This was done so that lsums and gsums have the same precision (FP)
+       ! Precision conversion occurs here from FP to (SP or DP)
+
+  sums = gsums
+
+       ! Clean up...
+
+  deallocate(lsums, gsums, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,"deallocate(lsums...",ierr)
+  endif
+
+ end subroutine row_sumSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: row_sumDP_ - Sum Elements in Each Row
+!
+! !DESCRIPTION:
+! Double precision version of row_sumSP_
+!
+! {\bf N.B.:  } This routine allocates an array {\tt sums}.  The user is
+! responsible for deallocating this array when it is no longer needed.  
+! Failure to do so will cause a memory leak.
+!
+! !INTERFACE:
+
+ subroutine row_sumDP_(sMat, num_rows, sums, comm)
+
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexIA => indexIA
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      integer,            intent(out) :: num_rows
+      real(DP), dimension(:), pointer :: sums
+
+
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Jan01 - Jay Larson <larson@mcs.anl.gov> - Prototype code.
+! 23Apr01 - Jay Larson <larson@mcs.anl.gov> - Modified to accomodate
+!           changes to the SparseMatrix type.
+! 18May01 - R. Jacob <jacob@mcs.anl.gov> - Use MP_TYPE function
+!           to set type in the mpi_allreduce
+! ______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::row_sumDP_'
+
+  integer :: i, igrow, ierr, iwgt, lsize, myID
+  integer :: start_row, end_row
+  integer :: mp_Type_lsums
+  real(FP), dimension(:), allocatable :: lsums
+  real(FP), dimension(:), allocatable :: gsums
+
+       ! Determine local rank
+
+  call MP_COMM_RANK(comm, myID, ierr)
+
+       ! Determine on each process the row of global row indices:
+
+  call global_row_range_(sMat, comm, start_row, end_row)
+
+       ! Determine across the communicator the _maximum_ value of
+       ! end_row, which will be assigned to num_rows on each process:
+
+  call MPI_ALLREDUCE(end_row, num_rows, 1, MP_INTEGER, MP_MAX, &
+                    comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_ALLREDUCE(end_row...",ierr)
+  endif
+
+       ! Allocate storage for the sums on each process.
+
+  allocate(lsums(num_rows), gsums(num_rows), sums(num_rows), stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,"allocate(lsums(...",ierr)
+  endif
+
+       ! Compute the local entries to lsum(1:num_rows) for each process:
+
+  lsize = AttrVect_lsize(sMat%data)
+  igrow = AttrVect_indexIA(aV=sMat%data,item='grow',dieWith=myname_)
+  iwgt = AttrVect_indexRA(aV=sMat%data,item='weight',dieWith=myname_)
+
+  lsums = 0._FP
+  do i=1,lsize
+     lsums(sMat%data%iAttr(igrow,i)) = lsums(sMat%data%iAttr(igrow,i)) + &
+	                           sMat%data%rAttr(iwgt,i)
+  end do
+
+       ! Compute the global sum of the entries of lsums so that all
+       ! processes own the global sums.
+
+  mp_Type_lsums=MP_Type(lsums)
+  call MPI_ALLREDUCE(lsums, gsums, num_rows, mp_Type_lsums, MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_ALLREDUCE(lsums...",ierr)
+  endif
+
+       ! Copy our temporary array gsums into the output pointer sums
+       ! This was done so that lsums and gsums have the same precision (FP)
+       ! Precision conversion occurs here from FP to (SP or DP)
+
+  sums = gsums
+
+       ! Clean up...
+
+  deallocate(lsums, gsums, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,"deallocate(lsums...",ierr)
+  endif
+
+ end subroutine row_sumDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: row_sum_checkSP_ - Check Row Sums vs. Valid Values
+!
+! !DESCRIPTION:  The routine {\tt row\_sum\_check()} sums the rows of 
+! the input distributed (across the communicator identified by {\tt comm}) 
+! {\tt SparseMatrix} variable {\tt sMat}.  It then compares these sums 
+! with the {\tt num\_valid} input "valid" values stored in the array 
+! {\tt valid\_sums}.  If all of the sums are within the absolute tolerence
+! specified by the input argument {\tt abs\_tol} of any of the valid values,
+! the output {\tt LOGICAL} flag {\tt valid} is set to {\tt .TRUE}.  
+! Otherwise, this flag is returned with value {\tt .FALSE}.
+!
+! !INTERFACE:
+
+ subroutine row_sum_checkSP_(sMat, comm, num_valid, valid_sums, abs_tol, valid)
+
+!
+! !USES:
+!
+      use m_die
+      use m_realkinds, only : SP, FP
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+      integer,            intent(in)  :: num_valid
+      real(SP),           intent(in)  :: valid_sums(num_valid)
+      real(SP),           intent(in)  :: abs_tol
+
+! !OUTPUT PARAMETERS:
+
+      logical,            intent(out) :: valid
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Prototype code.
+! 06Jan03 - R. Jacob <jacob@mcs.anl.gov> - create DP and SP versions
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::row_sum_checkSP_'
+
+  integer :: i, j, num_invalid, num_rows
+  real(FP), dimension(:), pointer :: sums
+
+       ! Compute row sums:
+
+  call row_sum(sMat, num_rows, sums, comm)
+
+       ! Initialize for the scanning loop (assume the matrix row
+       ! sums are valid):
+
+  valid = .TRUE.
+  i = 1
+
+  SCAN_LOOP:  do 
+
+       ! Count the number of elements in valid_sums(:) that
+       ! are separated from sums(i) by more than abs_tol
+
+     num_invalid = 0
+
+     do j=1,num_valid
+	if(abs(sums(i) - valid_sums(j)) > abs_tol) then
+	   num_invalid = num_invalid + 1
+	endif
+     end do
+
+       ! If num_invalid = num_valid, then we have failed to
+       ! find a valid sum value within abs_tol of sums(i).  This
+       ! one failure is enough to halt the process.
+
+     if(num_invalid == num_valid) then
+	valid = .FALSE.
+	EXIT
+     endif
+
+       ! Prepare index i for the next element of sums(:)
+
+     i = i + 1
+     if( i > num_rows) EXIT
+
+  end do SCAN_LOOP
+
+ end subroutine row_sum_checkSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: row_sum_checkDP_ - Check Row Sums vs. Valid Values
+!
+! !DESCRIPTION:
+! Double precision version of row_sum_checkSP
+!
+! !INTERFACE:
+
+ subroutine row_sum_checkDP_(sMat, comm, num_valid, valid_sums, abs_tol, valid)
+
+!
+! !USES:
+!
+      use m_die
+      use m_realkinds, only : DP, FP
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(SparseMatrix), intent(in)  :: sMat
+      integer,            intent(in)  :: comm
+      integer,            intent(in)  :: num_valid
+      real(DP),           intent(in)  :: valid_sums(num_valid)
+      real(DP),           intent(in)  :: abs_tol
+
+! !OUTPUT PARAMETERS:
+
+      logical,            intent(out) :: valid
+
+! !REVISION HISTORY:
+! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
+! 25Feb01 - Jay Larson <larson@mcs.anl.gov> - Prototype code.
+! 06Jan03 - R. Jacob <jacob@mcs.anl.gov> - create DP and SP versions
+! ______________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::row_sum_checkDP_'
+
+  integer :: i, j, num_invalid, num_rows
+  real(FP), dimension(:), pointer :: sums
+
+       ! Compute row sums:
+
+  call row_sum(sMat, num_rows, sums, comm)
+
+       ! Initialize for the scanning loop (assume the matrix row
+       ! sums are valid):
+
+  valid = .TRUE.
+  i = 1
+
+  SCAN_LOOP:  do 
+
+       ! Count the number of elements in valid_sums(:) that
+       ! are separated from sums(i) by more than abs_tol
+
+     num_invalid = 0
+
+     do j=1,num_valid
+	if(abs(sums(i) - valid_sums(j)) > abs_tol) then
+	   num_invalid = num_invalid + 1
+	endif
+     end do
+
+       ! If num_invalid = num_valid, then we have failed to
+       ! find a valid sum value within abs_tol of sums(i).  This
+       ! one failure is enough to halt the process.
+
+     if(num_invalid == num_valid) then
+	valid = .FALSE.
+	EXIT
+     endif
+
+       ! Prepare index i for the next element of sums(:)
+
+     i = i + 1
+     if( i > num_rows) EXIT
+
+  end do SCAN_LOOP
+
+ end subroutine row_sum_checkDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Sort_ - Generate Index Permutation
+!
+! !DESCRIPTION:
+! The subroutine {\tt Sort\_()} uses a list of sorting keys defined by 
+! the input {\tt List} argument {\tt key\_list}, searches for the appropriate 
+! integer or real attributes referenced by the items in {\tt key\_list} 
+! ( that is, it identifies the appropriate entries in {sMat\%data\%iList} 
+! and {\tt sMat\%data\%rList}), and then uses these keys to generate an index 
+! permutation {\tt perm} that will put the nonzero matrix entries of stored
+! in {\tt sMat\%data} in lexicographic order as defined by {\tt key\_ist} 
+! (the ordering in {\tt key\_list} being from left to right.  The optional 
+! {\tt LOGICAL} array input argument {\tt descend} specifies whether or
+! not to sort by each key in {\em descending} order or {\em ascending} 
+! order.  Entries in {\tt descend} that have value {\tt .TRUE.} correspond 
+! to a sort by the corresponding key in descending order.  If the argument
+! {\tt descend} is not present, the sort is performed for all keys in
+! ascending order.
+!
+! !INTERFACE:
+
+ subroutine Sort_(sMat, key_list, perm, descend)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List ,         only : List
+
+      use m_AttrVect, only: AttrVect_Sort => Sort
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+
+      type(SparseMatrix),              intent(in) :: sMat
+      type(List),                      intent(in) :: key_list
+      logical, dimension(:), optional, intent(in) :: descend
+!
+! !OUTPUT PARAMETERS: 
+
+      integer, dimension(:), pointer              :: perm
+
+
+! !REVISION HISTORY:
+! 24Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Sort_'
+
+  if(present(descend)) then
+     call AttrVect_Sort(sMat%data, key_list, perm, descend)
+  else
+     call AttrVect_Sort(sMat%data, key_list, perm)
+  endif
+
+ end Subroutine Sort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: Permute_ - Permute Matrix Elements using Supplied Index Permutation
+!
+! !DESCRIPTION:
+! The subroutine {\tt Permute\_()} uses an input index permutation 
+! {\tt perm} to re-order the entries of the {\tt SparseMatrix} argument 
+! {\tt sMat}.  The index permutation {\tt perm} is generated using the 
+! routine {\tt Sort\_()} (in this module).
+!
+! !INTERFACE:
+
+ subroutine Permute_(sMat, perm)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_AttrVect, only: AttrVect_Permute => Permute
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+
+
+      integer, dimension(:), pointer               :: perm
+!
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),            intent(inout) :: sMat
+
+
+! !REVISION HISTORY:
+! 24Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::Permute_'
+
+  call AttrVect_Permute(sMat%data, perm)
+
+ end Subroutine Permute_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SortPermute_ - Sort and Permute Matrix Elements
+!
+! !DESCRIPTION:
+! The subroutine {\tt SortPermute\_()} uses a list of sorting keys defined 
+! by the input {\tt List} argument {\tt key\_list}, searches for the 
+! appropriate integer or real attributes referenced by the items in 
+! {\tt key\_ist} ( that is, it identifies the appropriate entries in 
+! {sMat\%data\%iList} and {\tt sMat\%data\%rList}), and then uses these 
+! keys to generate an index permutation that will put the nonzero matrix 
+! entries of stored in {\tt sMat\%data} in lexicographic order as defined 
+! by {\tt key\_list} (the ordering in {\tt key\_list} being from left to 
+! right.  The optional {\tt LOGICAL} array input argument {\tt descend} 
+! specifies whether or not to sort by each key in {\em descending} order 
+! or {\em ascending} order.  Entries in {\tt descend} that have value 
+! {\tt .TRUE.} correspond to a sort by the corresponding key in descending 
+! order.  If the argument {\tt descend} is not present, the sort is 
+! performed for all keys in ascending order.
+!
+! Once this index permutation is created, it is applied to re-order the 
+! entries of the {\tt SparseMatrix} argument {\tt sMat} accordingly.
+!
+! !INTERFACE:
+
+ subroutine SortPermute_(sMat, key_list, descend)
+
+!
+! !USES:
+!
+      use m_die ,          only : die
+      use m_stdio ,        only : stderr
+
+      use m_List ,         only : List
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+
+      type(List),                      intent(in)    :: key_list
+      logical, dimension(:), optional, intent(in)    :: descend
+!
+! !INPUT/OUTPUT PARAMETERS: 
+
+      type(SparseMatrix),              intent(inout) :: sMat
+
+! !REVISION HISTORY:
+! 24Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SortPermute_'
+
+  integer :: ier
+  integer, dimension(:), pointer :: perm
+
+       ! Create index permutation perm(:)
+
+  if(present(descend)) then
+     call Sort_(sMat, key_list, perm, descend)
+  else
+     call Sort_(sMat, key_list, perm)
+  endif
+
+       ! Apply index permutation perm(:) to re-order sMat:
+
+  call Permute_(sMat, perm)
+
+       ! Clean up
+
+  deallocate(perm, stat=ier)
+  if(ier/=0) call die(myname_, "deallocate(perm)", ier)
+
+ end subroutine SortPermute_
+
+ end module m_SparseMatrix
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixComms.F90	(revision 4775)
@@ -0,0 +1,699 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SparseMatrixComms.F90,v 1.16 2004-05-18 00:07:49 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SparseMatrixComms -- sparse matrix communications methods.
+!
+! !DESCRIPTION:
+! The {\tt SparseMatrix} datatype provides sparse matrix storage for 
+! the parallel matrix-vector multiplication ${\bf y} = {\bf M} {\bf x}$.
+! This module provides communications services for the {\tt SparseMatrix}
+! type.  These services include scattering matrix elements based on row or 
+! column decompositions, gathering of matrix elements to the root, and 
+! broadcasting from the root.
+!
+! {\bf N.B.:}  These routines will not communicate the vector portion
+! of a {\tt SparseMatrix}, if it has been initialized.  A WARNING will
+! be issued in most cases.  In general, do communication first,  then 
+! call {\tt vecinit}.
+!
+! !INTERFACE:
+
+ module m_SparseMatrixComms
+
+      private   ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+      public :: ScatterByColumn
+      public :: ScatterByRow
+      public :: Gather
+      public :: Bcast
+
+    interface ScatterByColumn ; module procedure &
+         ScatterByColumnGSMap_
+    end interface
+
+    interface ScatterByRow ; module procedure &
+         ScatterByRowGSMap_
+    end interface
+
+    interface Gather ; module procedure &
+	 GM_gather_, &
+	 GSM_gather_
+    end interface
+
+    interface Bcast ; module procedure Bcast_ ; end interface
+
+! !REVISION HISTORY:
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!           and API specifications.
+! 10May01 - J.W. Larson <larson@mcs.anl.gov> - added GM_gather_
+!           and cleaned up prologues.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SparseMatrixComms'
+
+ contains
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ScatterByColumnGSMap_ - Column-based scatter for SparseMatrix.
+! 
+! !DESCRIPTION: This routine scatters the input {\tt SparseMatrix} 
+! argument {\tt GsMat} (valid only on the root) to a distributed 
+! {\tt SparseMatrix} variable {\tt LsMat} across all the processes 
+! present on the communicator associated with the integer handle 
+! {\tt comm}.  The decomposition defining the scatter is supplied by the 
+! input {\tt GlobalSegMap} argument {\tt columnGSMap}.  The optional 
+! output {\tt INTEGER} flag {\tt stat} signifies a successful (failed) 
+! operation if it is returned with value zero (nonzero).
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt SparseMatrix} 
+! variable {\tt LsMat}.  The user must destroy this variable when it
+! is no longer needed by invoking {\tt SparseMatrix\_Clean()}.
+!
+! !INTERFACE:
+
+ subroutine ScatterByColumnGSMap_(columnGSMap, GsMat, LsMat, root, comm, stat)
+!
+! !USES:
+!
+
+   use m_die, only : MP_perr_die,die
+   use m_stdio
+   use m_mpif90
+
+   use m_List, only: List
+   use m_List, only: List_init => init
+   use m_List, only: List_clean => clean
+
+   use m_GlobalSegMap, only : GlobalSegMap
+   use m_GlobalSegMap, only : GlobalSegMap_clean => clean
+
+   use m_SparseMatrix, only : SparseMatrix
+   use m_SparseMatrix, only : SparseMatrix_nRows => nRows
+   use m_SparseMatrix, only : SparseMatrix_nCols => nCols
+   use m_SparseMatrix, only : SparseMatrix_SortPermute => SortPermute
+
+   use m_SparseMatrixDecomp, only : SparseMatrixDecompByColumn => ByColumn
+
+   use m_AttrVectComms, only : AttrVect_Scatter => scatter
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(GlobalSegMap), intent(in)    :: columnGSMap
+   integer,            intent(in)    :: root
+   integer,            intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(inout) :: GsMat
+
+! !OUTPUT PARAMETERS:
+!
+   type(SparseMatrix), intent(out) :: LsMat
+   integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 10May01 - J.W. Larson <larson@mcs.anl.gov> - cleaned up prologue.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Made status flag stat
+!           optional, and ititilaze it to zero if it is present.
+! 09Jul03 - E.T. Ong <eong@mcs.anl.gov> - added sorting to distributed
+!           matrix elements
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'ScatterByColumnGSMap_'
+! GlobalSegMap used to create column decomposition of GsMat
+  type(GlobalSegMap) :: MatGSMap
+! Storage for the number of rows and columns in the SparseMatrix
+  integer :: NumRowsColumns(2)
+! List storage for sorting keys
+  type(List) :: sort_keys
+! Process ID
+  integer :: myID
+! Error flag
+  integer :: ierr
+
+       ! Initialize stat if present
+
+  if(present(stat)) stat = 0
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+	call MP_perr_die(myname_,"MPI_COMM_RANK() failed",ierr)
+  endif
+
+       ! can't scatter vector parts.
+  if((myID.eq.root) .and. GsMat%vecinit) then
+      write(stderr,*) myname_,&
+      "WARNING: will not scatter vector parts of GsMat"
+  endif
+
+       ! Create from columnGSMap the corresponding GlobalSegMap
+       ! that will decompose GsMat by column the same way.
+
+  call SparseMatrixDecompByColumn(columnGSMap, GsMat, MatGSMap, root, comm)
+
+       ! Broadcast the resulting GlobalSegMap across the communicator
+
+       ! Scatter the matrix element data GsMat%data accordingly
+
+  call AttrVect_Scatter(GsMat%data, LsMat%data, MatGSMap, root, comm, ierr)
+
+  if(ierr /= 0) then
+     if(present(stat)) then
+	write(stderr,*) myname_,"::  AttrVect_Scatter(GsMat%data) failed--stat=", &
+	     ierr
+	stat = ierr
+	return
+     else
+	call die(myname_,"call AttrVect_Scatter(GsMat%data,..",ierr)
+     endif
+  endif
+
+       ! Now, distribute to all the processes the number of Rows and
+       ! columns in GsMat (which are valid on the root only at this point)
+
+  if(myID == root) then
+     NumRowsColumns(1) = SparseMatrix_nRows(GsMat)
+     NumRowsColumns(2) = SparseMatrix_nCols(GsMat)
+  endif
+
+  call MPI_Bcast(NumRowsColumns, 2, MP_INTEGER, root, comm, ierr)
+
+  if(ierr /= 0) then
+	call MP_perr_die(myname_,"MPI_Bcast(NumRowsColumns...",ierr)
+  endif
+
+       ! Unpack NumRowsColumns
+
+  LsMat%nrows = NumRowsColumns(1)
+  LsMat%ncols = NumRowsColumns(2)
+
+       ! Set the value of vecinit
+  LsMat%vecinit = .FALSE.
+
+       ! Finally, lets sort the distributed local matrix elements
+
+       ! Sort the matrix entries in sMat by column, then row.  
+       ! First, create the key list...
+
+  call List_init(sort_keys,'gcol:grow')
+
+       ! Now perform the sort/permute...
+  call SparseMatrix_SortPermute(LsMat, sort_keys)
+
+       ! Cleanup
+
+  call List_clean(sort_keys) 
+  call GlobalSegMap_clean(MatGSMap)
+
+ end subroutine ScatterByColumnGSMap_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ScatterByRowGSMap_ -Row-based scatter for SparseMatrix.
+! 
+! !DESCRIPTION: This routine scatters the input  {\tt SparseMatrix} 
+! argument {\tt GsMat} (valid only on the root) to a distributed 
+! {\tt SparseMatrix} variable {\tt LsMat} across all the processes 
+! present on the communicator associated with the integer handle 
+! {\tt comm}.  The decomposition defining the scatter is supplied by the 
+! input {\tt GlobalSegMap} argument {\tt rowGSMap}.  The output integer 
+! flag {\tt stat} signifies a successful (failed) operation if it is 
+! returned with value zero (nonzero).
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt SparseMatrix} 
+! variable {\tt LsMat}.  The user must destroy this variable when it
+! is no longer needed by invoking {\tt SparseMatrix\_Clean()}.
+!
+! !INTERFACE:
+
+ subroutine ScatterByRowGSMap_(rowGSMap, GsMat, LsMat, root, comm, stat)
+!
+! !USES:
+!
+   use m_die, only : MP_perr_die,die
+   use m_stdio
+   use m_mpif90
+
+   use m_List, only: List
+   use m_List, only: List_init => init
+   use m_List, only: List_clean => clean
+
+   use m_GlobalSegMap, only : GlobalSegMap
+   use m_GlobalSegMap, only : GlobalSegMap_clean => clean
+
+   use m_SparseMatrix, only : SparseMatrix
+   use m_SparseMatrix, only : SparseMatrix_nRows => nRows
+   use m_SparseMatrix, only : SparseMatrix_nCols => nCols
+   use m_SparseMatrix, only : SparseMatrix_SortPermute => SortPermute
+
+   use m_SparseMatrixDecomp, only : SparseMatrixDecompByRow => ByRow
+
+   use m_AttrVectComms, only : AttrVect_Scatter => scatter
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(GlobalSegMap), intent(in)    :: rowGSMap
+   integer,            intent(in)    :: root
+   integer,            intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(inout) :: GsMat
+
+! !OUTPUT PARAMETERS:
+!
+   type(SparseMatrix), intent(out) :: LsMat
+   integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 26Apr01 - R.L. Jacob  <jacob@mcs.anl.gov> - fix use statement
+!           from SMDecomp so it points to ByRow
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Made status flag stat
+!           optional, and initialize it to zero if it is present.
+! 09Jul03 - E.T. Ong <eong@mcs.anl.gov> - Added sorting to distributed
+!           matrix elements. 
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'ScatterByRowGSMap_'
+! GlobalSegMap used to create row decomposition of GsMat
+  type(GlobalSegMap) :: MatGSMap
+! Storage for the number of rows and columns in the SparseMatrix
+  integer :: NumRowsColumns(2)
+! List storage for sorting keys
+  type(List) :: sort_keys
+! Process ID
+  integer :: myID
+! Error flag
+  integer :: ierr
+
+       ! Initialize stat to zero (if present)
+
+  if(present(stat)) stat = 0
+
+       ! Which process are we?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_COMM_RANK() failed",ierr)
+  endif
+
+       ! can't scatter vector parts.
+  if((myID.eq.root) .and. GsMat%vecinit) then
+      write(stderr,*) myname_,&
+      "WARNING: will not scatter vector parts of GsMat."
+  endif
+
+       ! Create from rowGSMap the corresponding GlobalSegMap
+       ! that will decompose GsMat by row the same way.
+
+  call SparseMatrixDecompByRow(rowGSMap, GsMat, MatGSMap, root, comm)
+
+       ! Scatter the matrix element data GsMat%data accordingly
+
+  call AttrVect_Scatter(GsMat%data, LsMat%data, MatGSMap, root, comm, ierr)
+  if(ierr /= 0) then
+     if(present(stat)) then
+        write(stderr,*) myname_,"::  AttrVect_Scatter(GsMat%data) failed--stat=", &
+             ierr
+        stat = ierr
+        return
+     else
+        call die(myname_,"call AttrVect_Scatter(GsMat%data,..",ierr)
+     endif
+  endif
+
+       ! Now, distribute to all the processes the number of rows and
+       ! columns in GsMat (which are valid on the root only at this point)
+
+  if(myID == root) then
+     NumRowsColumns(1) = SparseMatrix_nRows(GsMat)
+     NumRowsColumns(2) = SparseMatrix_nCols(GsMat)
+  endif
+
+  call MPI_Bcast(NumRowsColumns, 2, MP_INTEGER, root, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_Bcast(NumRowsColumns...",ierr)
+  endif
+
+       ! Unpack NumRowsColumns
+
+  LsMat%nrows = NumRowsColumns(1)
+  LsMat%ncols = NumRowsColumns(2)
+
+       ! Set the value of vecinit
+  LsMat%vecinit = .FALSE.
+
+       ! Sort the matrix entries in sMat by row, then column.  
+       ! First, create the key list...
+
+  call List_init(sort_keys,'grow:gcol')
+
+       ! Now perform the sort/permute...
+  call SparseMatrix_SortPermute(LsMat, sort_keys)
+
+       ! Cleanup
+
+  call List_clean(sort_keys) 
+  call GlobalSegMap_clean(MatGSMap)
+
+ end subroutine ScatterByRowGSMap_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  GM_gather_ - Gather a distributed SparseMatrix to the root.
+!
+! !DESCRIPTION: This routine gathers the input distributed 
+! {\tt SparseMatrix} argument {\tt LsMat} to the {\tt SparseMatrix} 
+! variable {\tt GsMat} on the root.  The decomposition defining the gather 
+! is supplied by the input {\tt GlobalMap} argument {\tt GMap}.  The 
+! status flag {\tt stat} has value zero (nonzero) if the operation has 
+! succeeded (failed).
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt SparseMatrix} 
+! variable {\tt GsMat}.  The user must destroy this variable when it
+! is no longer needed by invoking {\tt SparseMatrix\_Clean()}.
+! 
+! !INTERFACE:
+
+ subroutine GM_gather_(LsMat, GsMat, GMap, root, comm, stat)
+!
+! !USES:
+!
+   use m_stdio
+   use m_die, only : die
+
+   use m_GlobalMap, only: GlobalMap
+
+   use m_SparseMatrix, only: SparseMatrix
+   use m_SparseMatrix, only: SparseMatrix_nRows => nRows
+   use m_SparseMatrix, only: SparseMatrix_nCols => nCols
+
+   use m_AttrVectComms, only : AttrVect_gather => gather
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(in) :: LsMat
+   type(GlobalMap),    intent(in) :: GMap
+   integer,            intent(in) :: root
+   integer,            intent(in) :: comm
+
+! !OUTPUT PARAMETERS:
+!
+   type(SparseMatrix), intent(out) :: GsMat
+   integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 10May01 - J.W. Larson <larson@mcs.anl.gov> - initial routine and
+!           prologue
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Made status flag stat
+!           optional, and ititilaze it to zero if it is present.
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'GM_gather_'
+  integer :: ierr
+
+       ! if stat is present, initialize its value to zero (success)
+
+  if(present(stat))  stat = 0
+
+  if(LsMat%vecinit) then
+      write(stderr,*) myname_,&
+      "WARNING: will not gather vector parts of LsMat."
+  endif
+
+  call AttrVect_gather(LsMat%data, GsMat%data, GMap, root, comm, ierr)
+  if(ierr /= 0) then
+     if(present(stat)) then
+        write(stderr,*) myname_,"::  AttrVect_Gather(LsMat%data...) failed--stat=", &
+             ierr
+        stat = ierr
+        return
+     else
+        call die(myname_,"call AttrVect_Scatter(LsMat%data...) failed",ierr)
+     endif
+  endif
+
+       ! For now, the GsMat inherits the number of rows and columns from
+       ! the corresponding values of LsMat on the root (this should be
+       ! checked in future versions).
+
+  GsMat%nrows = SparseMatrix_nRows(LsMat)
+  GsMat%ncols = SparseMatrix_nCols(LsMat)
+
+  GsMat%vecinit = .FALSE.
+
+ end subroutine GM_gather_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  GSM_gather_ - Gather a distributed SparseMatrix to the root.
+!
+! !DESCRIPTION: This routine gathers the input distributed 
+! {\tt SparseMatrix} argument {\tt LsMat} to the {\tt SparseMatrix} 
+! variable {\tt GsMat} on the root.  The decomposition defining the gather 
+! is supplied by the input {\tt GlobalSegMap} argument {\tt GSMap}.  The 
+! status flag {\tt stat} has value zero (nonzero) if the operation has 
+! succeeded (failed).
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt SparseMatrix} 
+! variable {\tt GsMat}.  The user must destroy this variable when it
+! is no longer needed by invoking {\tt SparseMatrix\_Clean()}.
+! 
+! !INTERFACE:
+
+ subroutine GSM_gather_(LsMat, GsMat, GSMap, root, comm, stat)
+!
+! !USES:
+!
+   use m_stdio
+   use m_die, only : die
+
+   use m_GlobalSegMap, only: GlobalSegMap
+
+   use m_SparseMatrix, only: SparseMatrix
+   use m_SparseMatrix, only: SparseMatrix_nRows => nRows
+   use m_SparseMatrix, only: SparseMatrix_nCols => nCols
+
+   use m_AttrVectComms, only : AttrVect_gather => gather
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(in) :: LsMat
+   type(GlobalSegMap), intent(in) :: GSMap
+   integer,            intent(in) :: root
+   integer,            intent(in) :: comm
+
+! !OUTPUT PARAMETERS:
+!
+   type(SparseMatrix), intent(out) :: GsMat
+   integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Made status flag stat
+!           optional, and ititilaze it to zero if it is present.
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'GSM_gather_'
+  integer :: ierr
+
+       ! if stat is present, initialize its value to zero (success)
+
+  if(present(stat))  stat = 0
+
+  if(LsMat%vecinit) then
+      write(stderr,*) myname_,&
+      "WARNING: will not gather vector parts of LsMat."
+  endif
+
+       ! Gather the AttrVect component of LsMat to GsMat...
+
+  call AttrVect_gather(LsMat%data, GsMat%data, GSMap, root, comm, ierr)
+  if(ierr /= 0) then
+     if(present(stat)) then
+        write(stderr,*) myname_,"::  AttrVect_Gather(LsMat%data...) failed--stat=", &
+             ierr
+        stat = ierr
+        return
+     else
+        call die(myname_,"call AttrVect_Gather(LsMat%data...)",ierr)
+     endif
+  endif
+
+       ! For now, the GsMat inherits the number of rows and columns from
+       ! the corresponding values of LsMat on the root (this should be
+       ! checked in future versions).
+
+  GsMat%nrows = SparseMatrix_nRows(LsMat)
+  GsMat%ncols = SparseMatrix_nCols(LsMat)
+
+  GsMat%vecinit = .FALSE.
+
+ end subroutine GSM_gather_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  Bcast_ - Broadcast a SparseMatrix.
+! 
+! !DESCRIPTION: This routine broadcasts the {\tt SparseMatrix} argument 
+! {\tt sMat} from the root to all processes on the communicator associated
+! with the communicator handle {\tt comm}.  The status flag {\tt stat} 
+! has value zero if the operation has succeeded.
+!
+! {\bf N.B.:}  This routine returns an allocated {\tt SparseMatrix} 
+! variable {\tt sMat}.  The user must destroy this variable when it
+! is no longer needed by invoking {\tt SparseMatrix\_Clean()}.
+!
+! {\bf N.B.:}  This routine will exit with an error if the vector portion
+! of {\tt sMat} has been initialized prior to broadcast.
+!
+! !INTERFACE:
+
+ subroutine Bcast_(sMat, root, comm, stat)
+
+!
+! !USES:
+!
+
+   use m_die, only : MP_perr_die,die
+   use m_stdio
+   use m_mpif90
+
+   use m_GlobalSegMap, only: GlobalSegMap
+
+   use m_AttrVectComms, only : AttrVect_bcast => bcast
+
+   use m_SparseMatrix, only: SparseMatrix
+   use m_SparseMatrix, only: SparseMatrix_nRows => nRows
+   use m_SparseMatrix, only: SparseMatrix_nCols => nCols
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   integer,            intent(in) :: root
+   integer,            intent(in) :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+!
+   integer, optional,  intent(out) :: stat
+
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec/code
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Made status flag stat
+!           optional, and ititilaze it to zero if it is present.
+! 17Jul02 - J.W. Larson <larson@mcs.anl.gov> - Bug fix--local 
+!           process ID myID was uninitialized.
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'Bcast_'
+
+! Storage for the number of rows and columns in the SparseMatrix
+  integer :: NumRowsColumns(2)
+! Process ID number
+  integer :: myID
+! Error flag
+  integer :: ierr
+
+       ! Initialize stat if present
+
+  if(present(stat)) stat = 0
+
+       ! Determine local process ID myID:
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_COMM_RANK() failed",ierr)
+  endif
+
+  if((myID.eq.root) .and. sMat%vecinit) then
+      write(stderr,*) myname_,&
+      "Cannot broadcast SparseMatrix with initialized vector parts." 
+      call die(myname_,"Gather SparseMatrix with vecinit TRUE.") 
+  endif
+
+       ! Broadcast sMat%data from the root
+
+  call AttrVect_bcast(sMat%data, root, comm, ierr)
+  if(ierr /= 0) then
+     if(present(stat)) then
+        write(stderr,*) myname_,"::  AttrVect_bcast(sMat%data...failed--stat=", &
+             ierr
+        stat = ierr
+        return
+     else
+        call die(myname_,"call AttrVect_bcast(sMat%data...) failed",ierr)
+     endif
+  endif
+
+  if(myID == root) then
+     NumRowsColumns(1) = SparseMatrix_nRows(sMat)
+     NumRowsColumns(2) = SparseMatrix_nCols(sMat)
+  endif
+
+  call MPI_Bcast(NumRowsColumns, 2, MP_INTEGER, root, comm, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,"MPI_Bcast(NumRowsColumns...",ierr)
+  endif
+
+       ! Unpack NumRowsColumns on broadcast destination processes
+
+  if(myID /= root) then
+     sMat%nrows = NumRowsColumns(1)
+     sMat%ncols = NumRowsColumns(2)
+  endif
+
+  sMat%vecinit = .FALSE.
+
+ end subroutine Bcast_
+
+ end module m_SparseMatrixComms
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixDecomp.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixDecomp.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixDecomp.F90	(revision 4775)
@@ -0,0 +1,756 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SparseMatrixDecomp.F90,v 1.15 2008-05-12 01:59:32 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SparseMatrixDecomp -- Parallel sparse matrix decomposition.
+!
+! !DESCRIPTION:
+! The {\tt SparseMatrix} datatype provides sparse matrix storage for 
+! the parallel matrix-vector multiplication ${\bf y} = {\bf M} {\bf x}$.
+! This module provides services to create decompositions for the 
+! {\tt SparseMatrix}.  The matrix decompositions available are row 
+! and column decompositions.  They are generated by invoking the 
+! appropriate routine in this module, and passing the corresponding 
+! {\em vector} decomposition.  For a row (column) decomposition, one 
+! invokes the routine {\tt ByRow()} ({\tt ByColumn()}), passing the 
+! domain decomposition for the vector {\bf y} ({\bf x}).
+!
+! !INTERFACE:
+
+ module m_SparseMatrixDecomp
+
+      private   ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+!
+      public :: ByColumn
+      public :: ByRow
+
+
+    interface ByColumn ; module procedure &
+         ByColumnGSMap_
+    end interface
+
+    interface ByRow ; module procedure &
+         ByRowGSMap_
+    end interface
+
+! !REVISION HISTORY:
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!           and API specifications.
+! 03Aug01 - E. Ong <eong@mcs.anl.gov> - in ByRowGSMap and ByColumnGSMap,
+!           call GlobalSegMap_init on non-root processes with actual 
+!           shaped arguments to satisfy Fortran 90 standard. See
+!           comments in ByRowGSMap/ByColumnGSMap.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SparseMatrixDecomp'
+
+ contains
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ByColumnGSMap_ - Generate Row-based GlobalSegMap for SparseMatrix
+! 
+! !INTERFACE:
+
+ subroutine ByColumnGSMap_(xGSMap, sMat, sMGSMap, root, comm)
+!
+! !USES:
+!
+   use m_die,  only: MP_perr_die,die
+
+   use m_List, only: List
+   use m_List, only: List_init => init
+   use m_List, only: List_clean => clean
+
+   use m_AttrVect, only: AttrVect
+   use m_AttrVect, only: AttrVect_init => init
+   use m_AttrVect, only: AttrVect_zero => zero
+   use m_AttrVect, only: AttrVect_lsize => lsize
+   use m_AttrVect, only: AttrVect_indexIA => indexIA
+   use m_AttrVect, only: AttrVect_copy => copy
+   use m_AttrVect, only: AttrVect_clean => clean
+   
+   use m_AttrVectComms, only: AttrVect_scatter => scatter
+   use m_AttrVectComms, only: AttrVect_gather => gather
+
+   use m_GlobalMap, only : GlobalMap
+   use m_GlobalMap, only : GlobalMap_init => init
+   use m_GlobalMap, only : GlobalMap_clean => clean
+
+   use m_GlobalSegMap, only: GlobalSegMap
+   use m_GlobalSegMap, only: GlobalSegMap_init => init
+   use m_GlobalSegMap, only: GlobalSegMap_peLocs => peLocs
+   use m_GlobalSegMap, only: GlobalSegMap_comp_id => comp_id
+
+   use m_SparseMatrix, only: SparseMatrix
+   use m_SparseMatrix, only: SparseMatrix_lsize => lsize
+   use m_SparseMatrix, only: SparseMatrix_SortPermute => SortPermute
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(GlobalSegMap), intent(in)    :: xGSMap
+   integer,            intent(in)    :: root
+   integer,            intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+!
+   type(GlobalSegMap), intent(out) :: sMGSMap
+
+! !DESCRIPTION: This routine is invoked from all processes on the 
+! communicator {\tt comm} to create from an input {\tt SparseMatrix}
+! {\tt sMat} (valid only on the {\tt root} process) and an input 
+! {\bf x}-vector decomposition described by the {\tt GlobalSegMap} 
+! argument {\tt xGSMap} (valid at least on the {\tt root}) to create 
+! an output {\tt GlobalSegMap} decomposition of the matrix elements 
+! {\tt sMGSMap}, which is valid on all processes on the communicator.
+! This matrix {\tt GlobalSegMap} describes the corresponding column 
+! decomposition of {\tt sMat}.
+!
+! {\bf N.B.}:  The argument {\tt sMat} is returned sorted in lexicographic 
+! order by column and row.
+!
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 26Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add use statements for
+!           GlobalSegMap_init and GSMap_peLocs.
+!           Add gsize argument required to GSMap_peLocs.
+!           Add underscore to ComputeSegments call so it matches
+!           the subroutine decleration.
+!           change attribute on starts,lengths, and pe_locs to
+!           pointer to match GSMap_init.
+!           add use m_die statement
+! 26Apr01 - J.W. Larson <larson@mcs.anl.gov> - fixed major logic bug
+!           that had all processes executing some operations that 
+!           should only occur on the root.
+! 09Jul03 - E.T. Ong <eong@mcs.anl.gov> - call pe_locs in parallel. 
+!           reduce the serial sort from gcol:grow to just gcol.
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'ByColumnGSMap_'
+! Process ID number
+  integer :: myID, mySIZE
+! Attributes for the output GlobalSegMap
+  integer :: gsize, comp_id, ngseg
+! Temporary array for identifying each matrix element column and 
+! process ID destination
+  type(AttrVect) :: gcol
+  type(AttrVect) :: dist_gcol
+  type(AttrVect) :: element_pe_locs 
+  type(AttrVect) :: dist_element_pe_locs
+! Index variables for the AttrVects
+  integer :: dist_gsize
+  integer :: gcol_index
+  integer :: element_pe_locs_index
+! Temporary array for initializing GlobalMap Decomposition
+  integer,dimension(:), allocatable :: counts
+! GlobalMap for setting up decomposition to call pe_locs
+  type(GlobalMap) :: dist_GMap
+! Temporary arrays for matrix GlobalSegMap attributes
+  integer, dimension(:), pointer :: starts, lengths, pe_locs
+! List storage for sorting keys
+  type(List) :: sort_keys
+! Error flag
+  integer :: ierr
+! Loop index
+  integer :: i
+
+       ! Determine process id number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'call MPI_COMM_RANK(...',ierr)
+  endif
+
+      ! Determine the number of processors in communicator
+
+  call MPI_COMM_SIZE(comm, mySIZE, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'call MPI_COMM_SIZE(...',ierr)
+  endif
+
+       ! Allocate space for GlobalMap length information
+
+  allocate(counts(0:mySIZE-1),stat=ierr)
+  if(ierr/=0) call die(myname_,"allocate(counts)",ierr)
+
+       ! First step:  a lot of prep work on the root only:
+
+  if(myID == root) then
+
+       ! Sort the matrix entries in sMat by column.  
+       ! First, create the key list...
+
+     call List_init(sort_keys,'gcol')
+
+       ! Now perform the sort/permute...
+
+     call SparseMatrix_SortPermute(sMat, sort_keys)
+
+     call List_clean(sort_keys)
+
+       ! The global size of matrix GlobalSegMap is the number nonzero
+       ! elements in sMat.  
+
+     gsize = SparseMatrix_lsize(sMat)
+
+       ! Allocate storage space for matrix element column indices and
+       ! process ID destinations
+
+     call AttrVect_init(aV=gcol, iList="gcol", lsize=gsize)
+
+       ! Extract global column information and place in array gCol
+
+     call AttrVect_copy(aVin=sMat%data, aVout=gcol, iList="gcol")
+
+       ! Setup GlobalMap decomposition lengths:
+
+     do i=0,mySIZE-1
+        counts(i) = gsize/mySIZE
+     enddo
+     counts(mySIZE-1) = counts(mySIZE-1) + mod(gsize,mySIZE)
+
+  endif
+
+       ! Initialize GlobalMap so that we can scatter the global row
+       ! information. The GlobalMap will inherit the component ID
+       ! from xGSMap
+
+  comp_id = GlobalSegMap_comp_id(xGSMap)
+
+  call GlobalMap_init(GMap=dist_GMap, comp_id=comp_id, lns=counts, &
+                      root=root, comm=comm)
+
+  call AttrVect_scatter(iV=gcol, oV=dist_gcol, GMap=dist_GMap, &
+                        root=root, comm=comm)
+
+       ! Similarly, we want to scatter the element_pe_locs using the 
+       ! same decomposition
+  
+  dist_gsize = AttrVect_lsize(dist_gcol)
+
+  call AttrVect_init(aV=dist_element_pe_locs, iList="element_pe_locs", &
+                     lsize=dist_gsize)
+  call AttrVect_zero(dist_element_pe_locs)
+     
+       ! Compute process ID destination for each matrix element,
+       ! and store in the AttrVect element_pe_locs
+
+  gcol_index = AttrVect_indexIA(dist_gcol,"gcol", dieWith=myname_)
+  element_pe_locs_index = AttrVect_indexIA(dist_element_pe_locs, &
+                            "element_pe_locs", dieWith=myname_)
+
+  call GlobalSegMap_peLocs(xGSMap, dist_gsize,      &
+          dist_gcol%iAttr(gcol_index,1:dist_gsize), &
+          dist_element_pe_locs%iAttr(element_pe_locs_index,1:dist_gsize))
+
+  call AttrVect_gather(iV=dist_element_pe_locs, oV=element_pe_locs, &
+                       GMap=dist_GMap, root=root, comm=comm)
+
+       ! Back to the root operations
+
+  if(myID == root) then
+
+       ! Sanity check: Is the globalsize of sMat the same as the 
+       ! gathered size of element_pe_locs?
+                  
+     if(gsize /= AttrVect_lsize(element_pe_locs)) then
+        call die(myname_,"gsize /= AttrVect_lsize(element_pe_locs) &
+                 & on root process")
+     endif
+       
+       ! Using the entries of gCol and element_pe_locs, build the
+       ! output GlobalSegMap attribute arrays starts(:), lengths(:),
+       ! and pe_locs(:)
+
+     gcol_index = AttrVect_indexIA(gcol,"gcol", dieWith=myname_)
+     element_pe_locs_index = AttrVect_indexIA(element_pe_locs, &
+                                "element_pe_locs", dieWith=myname_)
+
+     call ComputeSegments_(element_pe_locs%iAttr(element_pe_locs_index, &
+                                                              1:gsize), &
+                           gcol%iAttr(gcol_index,1:gsize), &
+                           gsize, ngseg, starts, lengths, pe_locs)
+       ! Clean up on the root
+
+     call AttrVect_clean(gcol)
+     call AttrVect_clean(element_pe_locs)
+
+  endif ! if(myID == root)
+
+       ! Non-root processes call GlobalSegMap_init with root_start, 
+       ! root_length, and root_pe_loc, although these arguments are 
+       ! not used in the subroutine. Since these correspond to dummy 
+       ! shaped array arguments in initr_, the Fortran 90 standard 
+       ! dictates that the actual arguments must contain complete shape 
+       ! information. Therefore, these array arguments must be 
+       ! allocated on all processes.
+
+  if(myID /= root) then
+     allocate(starts(0),lengths(0),pe_locs(0),stat=ierr)
+     if(ierr /= 0) then
+        call die(myname_,'non-root allocate(starts...',ierr)
+     endif
+  endif
+
+       ! Using this local data on the root, create the SparseMatrix 
+       ! GlobalSegMap sMGSMap (which will be valid on all processes
+       ! on the communicator:
+
+  call GlobalSegMap_init(sMGSMap, ngseg, starts, lengths, pe_locs, &
+                         root, comm, comp_id, gsize)
+
+       ! Clean up 
+
+  call GlobalMap_clean(dist_GMap)
+  call AttrVect_clean(dist_gcol)
+  call AttrVect_clean(dist_element_pe_locs)
+
+  deallocate(starts, lengths, pe_locs, counts, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,'deallocate(starts...',ierr)
+  endif
+
+
+ end subroutine ByColumnGSMap_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ByRowGSMap_ - Generate Row-based GlobalSegMap for SparseMatrix
+! 
+! !INTERFACE:
+
+ subroutine ByRowGSMap_(yGSMap, sMat, sMGSMap, root, comm)
+!
+! !USES:
+!
+
+   use m_die,  only: MP_perr_die,die
+
+   use m_List, only: List
+   use m_List, only: List_init => init
+   use m_List, only: List_clean => clean
+
+   use m_AttrVect, only: AttrVect
+   use m_AttrVect, only: AttrVect_init => init
+   use m_AttrVect, only: AttrVect_lsize => lsize
+   use m_AttrVect, only: AttrVect_indexIA => indexIA
+   use m_AttrVect, only: AttrVect_copy => copy
+   use m_AttrVect, only: AttrVect_clean => clean
+   use m_AttrVect, only: AttrVect_zero => zero
+   
+   use m_AttrVectComms, only: AttrVect_scatter => scatter
+   use m_AttrVectComms, only: AttrVect_gather => gather
+
+   use m_GlobalMap, only : GlobalMap
+   use m_GlobalMap, only : GlobalMap_init => init
+   use m_GlobalMap, only : GlobalMap_clean => clean
+
+   use m_GlobalSegMap, only: GlobalSegMap
+   use m_GlobalSegMap, only: GlobalSegMap_init => init
+   use m_GlobalSegMap, only: GlobalSegMap_peLocs => peLocs
+   use m_GlobalSegMap, only: GlobalSegMap_comp_id => comp_id
+
+   use m_SparseMatrix, only: SparseMatrix
+   use m_SparseMatrix, only: SparseMatrix_lsize => lsize
+   use m_SparseMatrix, only: SparseMatrix_SortPermute => SortPermute
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   type(GlobalSegMap), intent(in)    :: yGSMap
+   integer,            intent(in)    :: root
+   integer,            intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+   type(SparseMatrix), intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+!
+   type(GlobalSegMap), intent(out) :: sMGSMap
+
+! !DESCRIPTION: This routine is invoked from all processes on the 
+! communicator {\tt comm} to create from an input {\tt SparseMatrix}
+! {\tt sMat} (valid only on the {\tt root} process) and an input 
+! {\bf y}-vector decomposition described by the {\tt GlobalSegMap} 
+! argument {\tt yGSMap} (valid at least on the {\tt root}) to create 
+! an output {\tt GlobalSegMap} decomposition of the matrix elements 
+! {\tt sMGSMap}, which is valid on all processes on the communicator.
+! This matrix {\tt GlobalSegMap} describes the corresponding row 
+! decomposition of {\tt sMat}.
+!
+! {\bf N.B.}:  The argument {\tt sMat} is returned sorted in lexicographic 
+! order by row and column.
+!
+! !REVISION HISTORY: 
+!
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial API spec.
+! 26Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - add use statements for
+!           GlobalSegMap_init and GSMap_peLocs.
+!           Add gsize argument required to GSMap_peLocs.
+!           Add underscore to ComputeSegments call so it matches
+!           the subroutine decleration.
+!           change attribute on starts,lengths, and pe_locs to
+!            pointer to match GSMap_init.
+! 26Apr01 - J.W. Larson <larson@mcs.anl.gov> - fixed major logic bug
+!           that had all processes executing some operations that 
+!           should only occur on the root.
+! 09Jun03 - E.T. Ong <eong@mcs.anl.gov> - call peLocs in parallel.
+!           reduce the serial sort from grow:gcol to just grow.
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=*),parameter :: myname_=myname//'ByRowGSMap_'
+! Process ID number and communicator size
+  integer :: myID, mySIZE
+! Attributes for the output GlobalSegMap
+  integer :: gsize, comp_id, ngseg
+! Temporary array for identifying each matrix element row and 
+! process ID destination
+  type(AttrVect) :: grow
+  type(AttrVect) :: dist_grow
+  type(AttrVect) :: element_pe_locs 
+  type(AttrVect) :: dist_element_pe_locs
+! Index variables for AttrVects
+  integer :: dist_gsize
+  integer :: grow_index
+  integer :: element_pe_locs_index
+! Temporary array for initializing GlobalMap Decomposition
+  integer,dimension(:), allocatable :: counts
+! GlobalMap for setting up decomposition to call pe_locs
+  type(GlobalMap) :: dist_GMap
+! Temporary arrays for matrix GlobalSegMap attributes
+  integer, dimension(:), pointer :: starts, lengths, pe_locs
+! List storage for sorting keys
+  type(List) :: sort_keys
+! Error flag
+  integer :: ierr
+! Loop index
+  integer :: i
+
+       ! Determine process id number myID
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'call MPI_COMM_RANK(...',ierr)
+  endif
+
+       ! Determine the number of processors in communicator
+
+  call MPI_COMM_SIZE(comm, mySIZE, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'call MPI_COMM_SIZE(...',ierr)
+  endif
+
+       ! Allocate space for GlobalMap length information
+
+  allocate(counts(0:mySIZE-1),stat=ierr)
+  if(ierr/=0) call die(myname_,"allocate(counts)",ierr)
+
+       ! First step:  a lot of prep work on the root only:
+
+  if(myID == root) then
+
+       ! Sort the matrix entries in sMat by row. 
+       ! First, create the key list...
+
+     call List_init(sort_keys,'grow')
+
+       ! Now perform the sort/permute...
+
+     call SparseMatrix_SortPermute(sMat, sort_keys)
+
+     call List_clean(sort_keys)
+
+       ! The global size of matrix GlobalSegMap is the number of rows.  
+
+     gsize = SparseMatrix_lsize(sMat)
+
+       ! Allocate storage space for matrix element row indices and
+       ! process ID destinations
+
+     call AttrVect_init(aV=grow, iList="grow", lsize=gsize)
+
+       ! Extract global row information and place in AttrVect grow
+
+     call AttrVect_copy(aVin=sMat%data, aVout=grow, iList="grow")
+
+       ! Setup GlobalMap decomposition lengths: 
+       ! Give any extra points to the last process
+
+     do i=0,mySIZE-1
+        counts(i) = gsize/mySIZE
+     enddo
+     counts(mySIZE-1) = counts(mySIZE-1) + mod(gsize,mySIZE)
+
+  endif
+  
+       ! Initialize GlobalMap and scatter the global row information.
+       ! The GlobalMap will inherit the component ID from yGSMap
+
+  comp_id = GlobalSegMap_comp_id(yGSMap)
+     
+  call GlobalMap_init(GMap=dist_GMap, comp_id=comp_id, lns=counts, &
+                      root=root, comm=comm)
+
+  call AttrVect_scatter(iV=grow, oV=dist_grow, GMap=dist_GMap, &
+                        root=root, comm=comm)
+
+       ! Similarly, we want to scatter the element_pe_locs using the 
+       ! same decomposition
+  
+  dist_gsize = AttrVect_lsize(dist_grow)
+
+  call AttrVect_init(aV=dist_element_pe_locs, iList="element_pe_locs", &
+                     lsize=dist_gsize)
+  call AttrVect_zero(dist_element_pe_locs)
+     
+       ! Compute process ID destination for each matrix element,
+       ! and store in the AttrVect element_pe_locs
+
+  grow_index = AttrVect_indexIA(dist_grow,"grow", dieWith=myname_)
+  element_pe_locs_index = AttrVect_indexIA(dist_element_pe_locs, &
+                            "element_pe_locs", dieWith=myname_)
+
+  call GlobalSegMap_peLocs(yGSMap, dist_gsize,      &
+          dist_grow%iAttr(grow_index,1:dist_gsize), &
+          dist_element_pe_locs%iAttr(element_pe_locs_index,1:dist_gsize))
+
+       ! Gather element_pe_locs on root so that we can call compute_segments
+
+  call AttrVect_gather(iV=dist_element_pe_locs, oV=element_pe_locs, &
+                       GMap=dist_GMap, root=root, comm=comm)
+
+       ! Back to the root operations
+
+  if(myID == root) then
+
+       ! Sanity check: Is the globalsize of sMat the same as the 
+       ! gathered size of element_pe_locs?
+                  
+     if(gsize /= AttrVect_lsize(element_pe_locs)) then
+        call die(myname_,"gsize /= AttrVect_lsize(element_pe_locs) &
+                 & on root process")
+     endif
+
+       ! Using the entries of grow and element_pe_locs, build the
+       ! output GlobalSegMap attribute arrays starts(:), lengths(:),
+       ! and pe_locs(:)
+
+     grow_index = AttrVect_indexIA(grow,"grow", dieWith=myname_)
+     element_pe_locs_index = AttrVect_indexIA(element_pe_locs, &
+                                "element_pe_locs", dieWith=myname_)
+
+     call ComputeSegments_(element_pe_locs%iAttr(element_pe_locs_index, &
+                                                              1:gsize), &
+                           grow%iAttr(grow_index,1:gsize), &
+                           gsize, ngseg, starts, lengths, pe_locs)
+
+       ! Clean up on the root
+
+     call AttrVect_clean(grow)
+     call AttrVect_clean(element_pe_locs)
+
+  endif ! if(myID == root)
+
+       ! Non-root processes call GlobalSegMap_init with root_start, 
+       ! root_length, and root_pe_loc, although these arguments are 
+       ! not used in the subroutine. Since these correspond to dummy 
+       ! shaped array arguments in initr_, the Fortran 90 standard 
+       ! dictates that the actual arguments must contain complete shape 
+       ! information. Therefore, these array arguments must be 
+       ! allocated on all processes.
+
+  if(myID /= root) then
+     allocate(starts(0),lengths(0),pe_locs(0),stat=ierr)
+     if(ierr /= 0) then
+	call die(myname_,'non-root allocate(starts...',ierr)
+     endif
+  endif
+
+       ! Using this local data on the root, create the SparseMatrix 
+       ! GlobalSegMap sMGSMap (which will be valid on all processes
+       ! on the communicator. The GlobalSegMap will inherit the 
+       ! component ID from yGSMap
+
+  call GlobalSegMap_init(sMGSMap, ngseg, starts, lengths, pe_locs, &
+                         root, comm, comp_id, gsize)
+
+       ! Clean up:
+
+  call GlobalMap_clean(dist_GMap)
+  call AttrVect_clean(dist_grow)
+  call AttrVect_clean(dist_element_pe_locs)
+
+  deallocate(starts, lengths, pe_locs, counts, stat=ierr)
+  if(ierr /= 0) then
+     call die(myname_,'deallocate(starts...',ierr)
+  endif
+
+
+ end subroutine ByRowGSMap_
+
+!-------------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory     !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE:  ComputeSegments_ - Create segments from list data.
+! 
+! !INTERFACE:
+
+ subroutine ComputeSegments_(element_pe_locs, elements, num_elements, &
+                             nsegs, seg_starts, seg_lengths, seg_pe_locs)
+!
+! !USES:
+!
+
+   use m_die,  only: die
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+   integer, dimension(:), intent(in)  :: element_pe_locs
+   integer, dimension(:), intent(in)  :: elements
+   integer,               intent(in)  :: num_elements
+
+! !OUTPUT PARAMETERS:
+!
+   integer,               intent(out) :: nsegs
+   integer, dimension(:), pointer     :: seg_starts
+   integer, dimension(:), pointer     :: seg_lengths
+   integer, dimension(:), pointer     :: seg_pe_locs
+
+! !DESCRIPTION: This routine examins an input list of {\tt num\_elements} 
+! process ID locations stored in the array {\tt element\_pe\_locs}, counts
+! the number of contiguous segments {\tt nsegs}, and returns the segment 
+! start index, length, and process ID location in the arrays {\tt seg\_starts(:)},
+! {\tt seg\_lengths(:)}, and {\tt seg\_pe\_locs(:)}, respectively.
+!
+! {\bf N.B.}:  The argument {\tt sMat} is returned sorted in lexicographic 
+! order by row and column.
+!
+! !REVISION HISTORY: 
+!
+! 18Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial version.
+! 28Aug01 - M.J. Zavislak <zavislak@mcs.anl.gov>
+!               Changed first sanity check to get size(element_pe_locs)
+!               instead of size(elements)
+!EOP
+!-------------------------------------------------------------------------
+  character(len=*),parameter :: myname_=myname//'ComputeSegments_'
+
+  integer :: i, ierr, iseg
+
+       ! Input argument sanity checks:
+
+  if(size(element_pe_locs) < num_elements) then
+     call die(myname_,'input argument array element_pe_locs too small', &
+	  num_elements-size(element_pe_locs))
+  endif
+
+  if(size(elements) < num_elements) then
+     call die(myname_,'input argument array elements too small', &
+	  num_elements-size(elements))
+  endif
+
+       ! First pass:  how many segments?
+
+  do i=1,num_elements
+
+     if(i == 1) then ! bootstrap segment count
+
+	nsegs = 1
+
+     else ! usual point/segment processing
+
+       ! New segment?  If so, increment nsegs.
+
+	if((elements(i) > elements(i-1) + 1) .or. &
+	     (element_pe_locs(i) /= element_pe_locs(i-1))) then ! new segment
+	   nsegs = nsegs + 1
+	endif
+
+     endif ! if(i == 1) block
+
+  end do  ! do i=1,num_elements
+
+  allocate(seg_starts(nsegs), seg_lengths(nsegs), seg_pe_locs(nsegs), &
+           stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'allocate(seg_starts...',ierr)
+  endif
+
+       ! Second pass:  fill in segment data.
+
+       ! NOTE: Structure of this loop was changed from a for loop
+       ! to avoid a faulty vectorization on the SUPER-UX compiler
+
+  i=1
+  ASSIGN_LOOP: do
+
+     if(i == 1) then  ! bootstrap first segment info.
+
+        iseg = 1
+        seg_starts(iseg) = 1
+        seg_lengths(iseg) = 1
+        seg_pe_locs(iseg) = element_pe_locs(iseg)
+
+     else ! do usual point/segment processing
+
+	! New segment?  This happens if 1) elements(i) > elements(i-1) + 1, or
+	! 2) element_pe_locs(i) /= element_pe_locs(i-1).
+     
+	if((elements(i) > elements(i-1) + 1) .or. &
+	     (element_pe_locs(i) /= element_pe_locs(i-1))) then ! new segment
+
+	   ! Initialize new segment
+	   iseg = iseg + 1
+	   seg_starts(iseg) = i
+	   seg_lengths(iseg) = 1
+	   seg_pe_locs(iseg) = element_pe_locs(i)
+
+	else
+
+	   ! Increment current segment length
+	   seg_lengths(iseg) = seg_lengths(iseg) + 1
+
+	endif ! If new segment block
+
+     endif ! if(i == 1) block
+
+     ! Prepare index i for the next loop around; 
+     if(i>=num_elements) EXIT
+     i = i + 1
+
+  end do ASSIGN_LOOP 
+
+  if(iseg /= nsegs) then
+     call die(myname_,'segment number difference',iseg-nsegs)
+  endif
+
+ end subroutine ComputeSegments_
+
+ end module m_SparseMatrixDecomp
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixPlus.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixPlus.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixPlus.F90	(revision 4775)
@@ -0,0 +1,871 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SparseMatrixPlus -- Class Parallel for Matrix-Vector Multiplication
+!
+! !DESCRIPTION:
+! Matrix-vector multiplication is one of the MCT's core services, and is 
+! used primarily for the interpolation of data fields from one physical 
+! grid to another.  Let ${\bf x} \in \Re^{N_x}$ and 
+! ${\bf y} \in \Re^{N_y}$ represent data fields on physical grids $A$ 
+! and $B$, respectively.  Field data is interpolated from grid $A$ to grid 
+! $B$ by
+! $$ {\bf y} = {\bf M} {\bf x} , $$
+! where {\bf M} is aa  ${N_y} \times {N_x}$ matrix.
+! 
+! Within MCT, the {\tt SparseMatrix} data type is MCT's object for 
+! storing sparse matrices such as {\bf M} , and the {\tt AttrVect} data 
+! type is MCT's field data storage object.  That is, {\bf x} and {\bf y} 
+! are each stored in {\tt AttrVect} form, and {\bf M} is stored as a 
+! {\tt SparseMatrix}.  
+!
+! For global address spaces (uniprocessor or shared-memory parallel), this 
+! picture of matrix-vector multiplication is sufficient.  If one wishes 
+! to perform {\em distributed-memory parallel} matrix-vector multiplication, 
+! however, in addition to computation, one must consider {\em communication}.
+!
+! There are three basic message-passing parallel strategies for computing 
+! ${\bf y} = {\bf M} {\bf x}$:
+!
+!\begin{enumerate}
+! \item Decompose {\bf M} based on its {\em rows}, and corresponding to the 
+! decomposition for the vector {\bf y}.  That is, if a given process owns 
+! the $i^{\rm th}$ element of {\bf y}, then all the elements of row $i$ of 
+! {\bf M} also reside on this process.  Then  ${\bf y} = {\bf M} {\bf x}$ is 
+! implemented as follows:
+! \begin{enumerate}
+! \item Create an {\em intermediate vector} {\bf x'} that is the pre-image of 
+! the elements of {\bf y} owned locally.
+! \item Comunnicate with the appropriate processes on the local communicator to 
+! gather from {\bf x} the elements of {\bf x'}.
+! \item Compute ${\bf y} = {\bf M} {\bf x'}$.
+! \item Destroy the data structure holding {\bf x'}.
+! \end{enumerate}
+! \item Decompose {\bf M} based on its {\em columns}, and corresponding to the 
+! decomposition for the vector {\bf x}.  That is, if a given process owns 
+! the $j^{\rm th}$ element of {\bf x}, then all the elements of column $j$ of 
+! {\bf M} also reside on this process.  Then  ${\bf y} = {\bf M} {\bf x}$ is 
+! implemented as follows:
+! \begin{enumerate}
+! \item Create an {\em intermediate vector} {\bf y'} that holds {\em partial sums}
+! of elements of {\bf y} computed from {\bf x} and {\bf M}.
+! \item Compute ${\bf y'} = {\bf M} {\bf x}$.
+! \item Perform communications to route elements of {\bf y'} to their eventual 
+! destinations in {\bf y}, where they will be summed, resulting in the distributed 
+! vector {\bf y}.
+! \item Destroy the data structure holding {\bf y'}.
+! \end{enumerate}
+! \item Decompose {\bf M} based on some arbitrary, user-supplied scheme.  This will 
+! necessitate two intermediate vectors {\bf x'} and {\bf y'}. Then  
+! ${\bf y} = {\bf M} {\bf x}$ is implemented as follows: 
+! \begin{enumerate}
+! \item Create {\em intermediate vectors} {\bf x'} and {\bf y'}.  The numbers of 
+! elements in {\bf x'} and {\bf y'} are based {\bf M}, specifically its numbers of 
+! {\em distinct} row and column index values, respectively.
+! \item Comunnicate with the appropriate processes on the local communicator to 
+! gather from {\bf x} the elements of {\bf x'}.
+! \item Compute ${\bf y'} = {\bf M} {\bf x'}$.
+! \item Perform communications to route elements of {\bf y'} to their eventual 
+! destinations in {\bf y}, where they will be summed, resulting in the distributed 
+! vector {\bf y}.
+! \item Destroy the data structures holding {\bf x'} and {\bf y'}.
+! \end{enumerate}
+! \end{enumerate}
+!
+! These operations require information about many aspects of the multiplication 
+! process.  These data are:
+! \begin{itemize}
+! \item The matrix-vector parallelization strategy, which is one of the following:
+! \begin{enumerate}
+! \item Distributed in {\bf x}, purely data local in {\bf y}, labeled by the 
+! public data member {\tt Xonly}
+! \item Purely data local {\bf x}, distributed in {\bf y}, labeled by the 
+! public data member {\tt Yonly}
+! \item Distributed in both {\bf x} and {\bf y}, labeled by the public data 
+! member {\tt XandY}
+! \end{enumerate}
+! \item A communications scheduler to create {\bf x'} from {\bf x};
+! \item A communications scheduler to deliver partial sums contained in {\bf y'} to 
+! {\bf y}.
+! \item Lengths of the intermediate vectors {\bf x'} and {\bf y'}.
+! \end{itemize}
+!
+! In MCT, the above data are stored in a {\em master} class for {\tt SparseMatrix}-
+! {\tt AttrVect} multiplication.  This master class is called a 
+! {\tt SparseMatrixPlus}.
+!
+! This module contains the definition of the {\tt SparseMatrixPlus}, and a variety 
+! of methods to support it.  These include initialization, destruction, query, and 
+! data import/export.
+!
+! !INTERFACE:
+
+ module m_SparseMatrixPlus
+
+! !USES:
+
+      use m_String, only : String
+      use m_SparseMatrix, only : SparseMatrix
+      use m_Rearranger, only : Rearranger
+
+! !PUBLIC TYPES:
+
+      public :: SparseMatrixPlus
+
+      Type SparseMatrixPlus
+#ifdef SEQUENCE
+        sequence
+#endif
+        type(String) :: Strategy
+        integer :: XPrimeLength
+        type(Rearranger) :: XToXPrime
+        integer :: YPrimeLength
+        type(Rearranger) :: YPrimeToY
+        type(SparseMatrix) :: Matrix
+	integer :: Tag
+      End Type SparseMatrixPlus
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init
+      public :: vecinit
+      public :: clean
+      public :: initialized
+      public :: exportStrategyToChar
+
+      interface init ; module procedure &
+        initFromRoot_, &
+        initDistributed_
+      end interface
+      interface vecinit ; module procedure vecinit_ ; end interface
+      interface clean ; module procedure clean_ ; end interface
+      interface initialized ; module procedure initialized_ ; end interface
+      interface exportStrategyToChar ; module procedure &
+        exportStrategyToChar_ 
+      end interface
+
+! !PUBLIC DATA MEMBERS:
+
+      public :: Xonly ! Matrix decomposed only by ROW (i.e., based 
+                      ! on the decomposition of y); comms x->x'
+      public :: Yonly ! Matrix decomposed only by COLUMN (i.e., based 
+                      ! on the decomposition of x); comms y'->y
+      public :: XandY ! Matrix has complex ROW/COLUMN decomposed
+
+! !DEFINED PARAMETERS:
+
+      integer,parameter                    :: DefaultTag = 700
+
+
+! !SEE ALSO:
+! The MCT module m_SparseMatrix for more information about Sparse Matrices.
+! The MCT module m_Rearranger for deatailed information about Communications 
+! scheduling.
+! The MCT module m_AttrVect for details regarding the Attribute Vector.
+! The MCT module m_MatAttrVectMult for documentation of API's that use 
+! the SparseMatrixPlus.
+!
+! !REVISION HISTORY:
+! 29August 2002 - J. Larson <larson@mcs.anl.gov> - API specification.
+!EOP -------------------------------------------------------------------
+
+      character(len=*), parameter :: Xonly = 'Xonly'
+      character(len=*), parameter :: Yonly = 'Yonly'
+      character(len=*), parameter :: XandY = 'XandY'
+
+      character(len=*), parameter :: myname = 'MCT::m_SparseMatrixPlus'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initFromRoot_ - Creation and Initializtion from the Root
+!
+! !DESCRIPTION:  
+! This routine creates an {\tt SparseMatrixPlus} {\tt sMatPlus} using 
+! the following elements:
+! \begin{itemize}
+! \item A {\tt SparseMatrix} (the input argument {\tt sMat}), whose 
+! elements all reside only on the {\tt root} process of the MPI 
+! communicator with an integer handle defined by the input {\tt INTEGER} 
+! argument {\tt comm};
+! \item A {\tt GlobalSegMap} (the input argument {\tt xGSMap}) describing
+! the domain decomposition of the vector {\bf x} on the communicator 
+! {\tt comm};
+! \item A {\tt GlobalSegMap} (the input argument {\tt yGSMap}) describing
+! the domain decomposition of the vector {\bf y} on the communicator 
+! {\tt comm};
+! \item The matrix-vector multiplication parallelization strategy.  This
+! is set by the input {\tt CHARACTER} argument {\tt strategy}, which must 
+! have value corresponding to one of the following public data members 
+! defined in the declaration section of this module.  Acceptable values 
+! for use in this routine are: {\tt Xonly} and {\tt Yonly}.
+! \end{itemize}
+! The optional argument {\tt Tag} can be used to set the tag value used in 
+! the call to {\tt Rearranger}.  DefaultTag will be used otherwise.
+!
+! !INTERFACE:
+
+ subroutine initFromRoot_(sMatPlus, sMat, xGSMap, yGSMap, strategy, &
+                          root, comm, ComponentID, Tag)
+
+! !USES:
+
+      use m_die
+      use m_stdio
+      use m_mpif90
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_clean => clean
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_nRows => nRows
+      use m_SparseMatrix, only : SparseMatrix_nCols => nCols
+
+      use m_SparseMatrixComms, only : SparseMatrix_ScatterByRow => ScatterByRow
+      use m_SparseMatrixComms, only : SparseMatrix_ScatterByColumn => &
+                                                                ScatterByColumn
+
+      use m_SparseMatrixToMaps, only : SparseMatrixToXGlobalSegMap
+      use m_SparseMatrixToMaps, only : SparseMatrixToYGlobalSegMap
+
+      use m_GlobalToLocal, only : GlobalToLocalMatrix
+
+      use m_Rearranger, only : Rearranger
+      use m_Rearranger, only : Rearranger_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),     intent(in)    :: xGSMap
+      type(GlobalSegMap),     intent(in)    :: yGSMap
+      character(len=*),       intent(in)    :: strategy
+      integer,                intent(in)    :: root
+      integer,                intent(in)    :: comm
+      integer,                intent(in)    :: ComponentID
+      integer,optional,       intent(in)    :: Tag
+
+! !INPUT/OUTPUT PARAMETERS:
+      
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      type(SparseMatrixPlus), intent(out)   :: SMatPlus
+
+! !REVISION HISTORY:
+! 30Aug02 - Jay Larson <larson@mcs.anl.gov> - API Specification
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initFromRoot_'
+
+  type(GlobalSegMap) :: xPrimeGSMap, yPrimeGSMap
+
+  integer :: myID, ierr
+
+       ! Set tag used in Rearranger call
+
+  SMatPlus%Tag = DefaultTag
+  if(present(Tag)) SMatPlus%Tag = Tag
+
+       ! set vector flag
+  SMatPlus%Matrix%vecinit = .FALSE.
+
+       ! Get local process ID number
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK() failed',ierr)
+  endif
+
+       ! Basic Input Argument Checks:
+
+       ! On the root, where the matrix is stored, do its number of 
+       ! rows and columns match the global lengths ofthe vectors y 
+       ! and x, respectively? 
+
+  if(myID == root) then
+
+     if(GlobalSegMap_gsize(yGSMap) /= SparseMatrix_nRows(sMat)) then
+	write(stderr,'(3a,i8,2a,i8)') myname_, &
+	     ':: FATAL--length of vector y different from row count of sMat.', &
+	     'Length of y = ',GlobalSegMap_gsize(yGSMap),' Number of rows in ',&
+	     'sMat = ',SparseMatrix_nRows(sMat)
+	call die(myname_)
+     endif
+
+     if(GlobalSegMap_gsize(xGSMap) /= SparseMatrix_nCols(sMat)) then
+	write(stderr,'(3a,i8,2a,i8)') myname_, &
+	     ':: FATAL--length of vector x different from column count of sMat.', &
+	     'Length of x = ',GlobalSegMap_gsize(xGSMap),' Number of columns in ',&
+	     'sMat = ',SparseMatrix_nCols(sMat)
+	call die(myname_)
+     endif
+
+  endif ! if(myID == root) then...
+
+       ! Check desired parallelization strategy name for validity.  
+       ! If either of the strategies supported by this routine are
+       ! provided, initialize the appropriate component of sMatPlus.
+
+  select case(strategy)
+  case(Xonly) ! decompose sMat by rows following decomposition of y
+     call String_init(sMatPlus%Strategy, strategy)
+  case(Yonly) ! decompose sMat by columns following decomposition of x
+     call String_init(sMatPlus%Strategy, strategy)
+  case(XandY) ! User has called the wrong routine.  Try initDistributed()
+              ! instead.
+     write(stderr,'(4a)') myname_, &
+	  ':: ERROR--Strategy name = ',strategy,' not supported by this routine.'
+  case default ! strategy name not recognized.
+     write(stderr,'(5a)') myname_, &
+	  ':: ERROR--Invalid parallelization strategy name = ',strategy,' not ', &
+	  'recognized by this module.'
+     call die(myname_)
+  end select
+
+       ! End Argument Sanity Checks.
+
+       ! Based on the parallelization strategy, scatter sMat into 
+       ! sMatPlus%Matrix accordingly.
+
+  select case(strategy)
+  case(Xonly)
+       ! Scatter sMat by Row
+     call SparseMatrix_ScatterByRow(yGSMap, sMat, sMatPlus%Matrix, root, &
+	                            comm, ierr)
+       ! Compute GlobalSegMap associated with intermediate vector x'
+     call SparseMatrixToXGlobalSegMap(sMatPlus%Matrix, xPrimeGSMap, &
+	                              root, comm, ComponentID)
+       ! Determine length of x' from xPrimeGSMap:
+     sMatPlus%XPrimeLength = GlobalSegMap_lsize(xPrimeGSMap, comm)
+       ! Create Rearranger to assemble x' from x
+     call Rearranger_init(xGSMap, xPrimeGSMap, comm, sMatPlus%XToXPrime)
+       ! Create local column indices based on xPrimeGSMap
+     call GlobalToLocalMatrix(sMatPlus%Matrix, xPrimeGSMap, 'column', comm)
+       ! Create local row indices based on yGSMap
+     call GlobalToLocalMatrix(sMatPlus%Matrix, yGSMap, 'row', comm)
+       ! Destroy intermediate GlobalSegMap for x'
+     call GlobalSegMap_clean(xPrimeGSMap)
+  case(Yonly)
+       ! Scatter sMat by Column
+     call SparseMatrix_ScatterByColumn(xGSMap, sMat, sMatPlus%Matrix, root, &
+	                               comm, ierr)
+       ! Compute GlobalSegMap associated with intermediate vector y'
+     call SparseMatrixToYGlobalSegMap(sMatPlus%Matrix, yPrimeGSMap, &
+	                              root, comm, ComponentID)
+       ! Determine length of y' from yPrimeGSMap:
+     sMatPlus%YPrimeLength = GlobalSegMap_lsize(yPrimeGSMap, comm)
+       ! Create Rearranger to assemble y from partial sums in y'
+     call Rearranger_init(yPrimeGSMap, yGSMap, comm, sMatPlus%YPrimeToY)
+       ! Create local row indices based on yPrimeGSMap
+     call GlobalToLocalMatrix(sMatPlus%Matrix, yPrimeGSMap, 'row', comm)
+       ! Create local column indices based on xGSMap
+     call GlobalToLocalMatrix(sMatPlus%Matrix, xGSMap, 'column', comm)
+       ! Destroy intermediate GlobalSegMap for y'
+     call GlobalSegMap_clean(yPrimeGSMap)
+  case default ! do nothing
+  end select
+
+ end subroutine initFromRoot_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initDistributed_ - Distributed Creation and Initializtion
+!
+! !DESCRIPTION:  
+! This routine creates an {\tt SparseMatrixPlus} {\tt sMatPlus} using 
+! the following elements:
+! \begin{itemize}
+! \item A {\tt SparseMatrix} (the input argument {\tt sMat}), whose 
+! elements have previously been destributed across the MPI communicator 
+! with an integer handle defined by the input {\tt INTEGER} argument 
+! {\tt comm};
+! \item A {\tt GlobalSegMap} (the input argument {\tt xGSMap}) describing
+! the domain decomposition of the vector {\bf x} on the communicator 
+! {\tt comm}; and
+! \item A {\tt GlobalSegMap} (the input argument {\tt yGSMap}) describing
+! the domain decomposition of the vector {\bf y} on the communicator 
+! {\tt comm};
+! \end{itemize}
+! The other input arguments required by this routine are the {\tt INTEGER} 
+! arguments {\tt root} and {\tt ComponentID}, which define the communicator 
+! root ID and MCT component ID, respectively.
+!
+! !INTERFACE:
+
+ subroutine initDistributed_(sMatPlus, sMat, xGSMap, yGSMap, root, comm, &
+                             ComponentID, Tag)
+
+! !USES:
+
+      use m_die
+      use m_stdio
+      use m_mpif90
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_gsize => gsize
+      use m_GlobalSegMap, only : GlobalSegMap_lsize => lsize
+      use m_GlobalSegMap, only : GlobalSegMap_clean => clean
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_nRows => nRows
+      use m_SparseMatrix, only : SparseMatrix_nCols => nCols
+      use m_SparseMatrix, only : SparseMatrix_Copy => Copy
+
+      use m_SparseMatrixComms, only : SparseMatrix_ScatterByRow => ScatterByRow
+      use m_SparseMatrixComms, only : SparseMatrix_ScatterByColumn => &
+                                                                ScatterByColumn
+
+      use m_SparseMatrixToMaps, only : SparseMatrixToXGlobalSegMap
+      use m_SparseMatrixToMaps, only : SparseMatrixToYGlobalSegMap
+
+      use m_GlobalToLocal, only : GlobalToLocalMatrix
+
+      use m_Rearranger, only : Rearranger
+      use m_Rearranger, only : Rearranger_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(GlobalSegMap),     intent(in)    :: xGSMap
+      type(GlobalSegMap),     intent(in)    :: yGSMap
+      integer,                intent(in)    :: root
+      integer,                intent(in)    :: comm
+      integer,                intent(in)    :: ComponentID
+      integer,optional,       intent(in)    :: Tag
+
+! !INPUT/OUTPUT PARAMETERS:
+      
+      type(SparseMatrix),     intent(inout) :: sMat
+
+! !OUTPUT PARAMETERS:
+
+      type(SparseMatrixPlus), intent(out)   :: SMatPlus
+
+! !REVISION HISTORY:
+! 30Aug02 - Jay Larson <larson@mcs.anl.gov> - API Specification
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::initDistributed_'
+
+  type(GlobalSegMap) :: xPrimeGSMap, yPrimeGSMap
+
+  integer :: myID, ierr
+
+       ! Set tag used in Rearranger call
+
+  SMatPlus%Tag = DefaultTag
+  if(present(Tag)) SMatPlus%Tag = Tag
+
+       ! Get local process ID number
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+     call MP_perr_die(myname_,'MPI_COMM_RANK() failed',ierr)
+  endif
+       ! Basic Input Argument Checks:
+
+       ! A portion of sMat (even if there are no nonzero elements in 
+       ! this local chunk) on each PE.  We must check to ensure the 
+       ! number rows and columns match the global lengths ofthe 
+       ! vectors y and x, respectively. 
+
+  if(GlobalSegMap_gsize(yGSMap) /= SparseMatrix_nRows(sMat)) then
+     write(stderr,'(3a,i8,2a,i8)') myname, &
+	  ':: FATAL--length of vector y different from row count of sMat.', &
+	  'Length of y = ',GlobalSegMap_gsize(yGSMap),' Number of rows in ',&
+	  'sMat = ',SparseMatrix_nRows(sMat)
+     call die(myname_)
+  endif
+
+  if(GlobalSegMap_gsize(xGSMap) /= SparseMatrix_nCols(sMat)) then
+     write(stderr,'(3a,i8,2a,i8)') myname, &
+	  ':: FATAL--length of vector x different from column count of sMat.', &
+	  'Length of x = ',GlobalSegMap_gsize(xGSMap),' Number of columns in ',&
+	  'sMat = ',SparseMatrix_nCols(sMat)
+     call die(myname_)
+  endif
+
+       ! End Argument Sanity Checks.
+
+       ! Set parallelization strategy to XandY, since the work distribution 
+       ! was previously determined and in principle can be *anything*
+
+  call String_init(sMatPlus%Strategy, XandY)
+
+       ! Based on the XandY parallelization strategy, build SMatPlus
+       ! First, copy Internals of sMat into sMatPlus%Matrix:
+  call SparseMatrix_Copy(sMat, sMatPlus%Matrix)
+       ! Compute GlobalSegMap associated with intermediate vector x'
+  call SparseMatrixToXGlobalSegMap(sMatPlus%Matrix, xPrimeGSMap, &
+                                   root, comm, ComponentID)
+       ! Determine length of x' from xPrimeGSMap:
+  sMatPlus%XPrimeLength = GlobalSegMap_lsize(xPrimeGSMap, comm)
+       ! Create Rearranger to assemble x' from x
+  call Rearranger_init(xGSMap, xPrimeGSMap, comm, sMatPlus%XToXPrime)
+       ! Create local column indices based on xPrimeGSMap
+  call GlobalToLocalMatrix(sMatPlus%Matrix, xPrimeGSMap, 'column', comm)
+       ! Destroy intermediate GlobalSegMap for x'
+  call GlobalSegMap_clean(xPrimeGSMap)
+       ! Compute GlobalSegMap associated with intermediate vector y'
+  call SparseMatrixToYGlobalSegMap(sMatPlus%Matrix, yPrimeGSMap, &
+	                           root, comm, ComponentID)
+       ! Determine length of y' from yPrimeGSMap:
+  sMatPlus%YPrimeLength = GlobalSegMap_lsize(yPrimeGSMap, comm)
+       ! Create Rearranger to assemble y from partial sums in y'
+  call Rearranger_init(yPrimeGSMap, yGSMap, comm, sMatPlus%YPrimeToY)
+       ! Create local row indices based on yPrimeGSMap
+  call GlobalToLocalMatrix(sMatPlus%Matrix, yPrimeGSMap, 'row', comm)
+       ! Destroy intermediate GlobalSegMap for y'
+  call GlobalSegMap_clean(yPrimeGSMap)
+
+ end subroutine initDistributed_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: vecinit_ - Initialize vector parts of a SparseMatrixPlus
+!
+! !DESCRIPTION:  
+! This routine will initialize the parts of the SparseMatrix in
+! the SparseMatrixPlus object that are used in the vector-friendly
+! version of the sparse matrix multiply.
+!
+! !INTERFACE:
+
+ subroutine vecinit_(SMatP)
+!
+! !USES:
+!
+      use m_die
+      use m_SparseMatrix, only : SparseMatrix_vecinit => vecinit
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(SparseMatrixPlus), intent(inout)  :: SMatP
+
+! !REVISION HISTORY:
+! 29Oct03 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::vecinit_'
+
+  call SparseMatrix_vecinit(SMatP%Matrix)
+
+ end subroutine vecinit_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Destruction of a SparseMatrixPlus Object
+!
+! !DESCRIPTION:  
+! This routine deallocates all allocated memory belonging to the 
+! input/output {\tt SparseMatrixPlus} argument {\tt SMatP}, and sets 
+! to zero its integer components describing intermediate vector length, 
+! and sets its {\tt LOGICAL} flag signifying initialization to 
+! {\tt .FALSE.}  The success (failure) of this operation is signified 
+! by the zero (non-zero) value of the optional {\tt INTEGER} output 
+! argument {\tt status}.  If the user does supply {\tt status} when 
+! invoking this routine, failure of {\tt clean\_()} will lead to 
+! termination of execution with an error message.
+!
+! !INTERFACE:
+
+ subroutine clean_(SMatP, status)
+
+! !USES:
+
+      use m_die
+      use m_stdio
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      use m_String, only : String_ToChar => toChar
+      use m_String, only : String_clean => clean
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_clean => clean
+
+      use m_Rearranger, only : Rearranger
+      use m_Rearranger, only : Rearranger_clean => clean
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+      type(SparseMatrixPlus), intent(inout)  :: SMatP
+
+! !OUTPUT PARAMETERS:
+
+      integer, optional,  intent(out)   :: status
+
+! !REVISION HISTORY:
+! 30Aug02 - Jay Larson <larson@mcs.anl.gov> - API Specification
+!EOP ___________________________________________________________________
+!
+  character(len=*),parameter :: myname_=myname//'::clean_'
+
+  integer :: myStatus
+  type(String) :: dummyStrategy ! SGI IR->WHIRL work-around
+  character(len=5) :: myStrategy
+
+       ! If status was supplied, set it to zero (success)
+
+  if(present(status)) status = 0
+
+       ! The following string copy is superfluous. It is placed here
+       ! to outwit a compiler bug in the SGI and SunOS compilers. 
+       ! It occurs when a component of a derived type is used as an
+       ! argument to String_ToChar. This bug crashes the compiler 
+       ! with the error message:
+       ! Error: Signal Segmentation fault in phase IR->WHIRL Conversion
+
+  call String_init(dummyStrategy, SMatP%Strategy)
+  myStrategy = String_ToChar(dummyStrategy)
+
+       ! Use SMatP%Strategy to determine which Rearranger(s) need
+       ! to be destroyed.  The CHARACTER parameters Xonly, Yonly, 
+       ! and XandY are inherited from the declaration section of 
+       ! this module.
+
+
+  select case(myStrategy)
+  case(Xonly) ! destroy X-rearranger only
+
+     call Rearranger_clean(SMatP%XToXprime, myStatus)
+     if(myStatus /= 0) then ! something went wrong
+	if(present(status)) then
+	   status = myStatus
+	   return
+	else
+	   write(stderr,'(3a,i8)') myname_, &
+	     ':: ERROR - call to Rearranger_clean(SMatP%XToXprime) failed.', &
+	     ' stat = ',myStatus
+	endif
+     endif
+
+  case(Yonly) ! destroy Y-rearranger only
+
+     call Rearranger_clean(SMatP%YprimeToY, myStatus)
+     if(myStatus /= 0) then ! something went wrong
+	if(present(status)) then
+	   status = myStatus
+	   return
+	else
+	   write(stderr,'(3a,i8)') myname_, &
+	     ':: ERROR - call to Rearranger_clean(SMatP%YPrimeToY) failed.', &
+	     ' stat = ',myStatus
+	endif
+     endif
+
+  case(XandY) ! destroy both X- and Y-rearrangers
+
+     call Rearranger_clean(SMatP%XToXprime, myStatus)
+     if(myStatus /= 0) then ! something went wrong
+	if(present(status)) then
+	   status = myStatus
+	   return
+	else
+	   write(stderr,'(3a,i8)') myname_, &
+	     ':: ERROR - call to Rearranger_clean(SMatP%XToXprime) failed.', &
+	     ' stat = ',myStatus
+	endif
+     endif
+
+     call Rearranger_clean(SMatP%YprimeToY, myStatus)
+     if(myStatus /= 0) then ! something went wrong
+	if(present(status)) then
+	   status = myStatus
+	   return
+	else
+	   write(stderr,'(3a,i8)') myname_, &
+	     ':: ERROR - call to Rearranger_clean(SMatP%YPrimeToY) failed.', &
+	     ' stat = ',myStatus
+	endif
+     endif
+
+  case default ! do nothing--corresponds to purely data local case
+  end select
+
+       ! Zero out XPrimeLength and YPrimeLength
+
+  SMatP%XPrimeLength = 0
+  SMatP%YPrimeLength = 0
+
+       ! Destroy the SparseMatrix component SMatP%Matrix
+
+  call SparseMatrix_clean(SMatP%Matrix, myStatus)
+  if(myStatus /= 0) then ! something went wrong
+     if(present(status)) then
+	status = myStatus
+	return
+     else
+        write(stderr,'(2a,i8)') myname_, &
+	  ':: ERROR - call to SparseMatrix_clean() failed with stat=',myStatus
+     endif
+  endif
+
+       ! Destroy the String SMatP%Strategy and its copy
+
+  call String_clean(SMatP%Strategy)
+  call String_clean(dummyStrategy)
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initialized_ - Confirmation of Initialization
+!
+! !DESCRIPTION:
+! This {\tt LOGICAL} query function tells the user if the input 
+! {\tt SparseMatrixPlus} argument {\tt sMatPlus} has been initialized.
+! The return value of {\tt initialized\_} is {\tt .TRUE.} if 
+! {\tt sMatPlus} has been previously initialized, {\tt .FALSE.} if it
+! has not.
+!
+! !INTERFACE:
+
+ logical function initialized_(sMatPlus)
+!
+! !USES:
+!
+! No external modules are used by this function.
+      
+      use m_String, only : String_len
+      use m_List,   only : List
+      use m_List,   only : List_init => init
+      use m_List,   only : List_identical => identical
+      use m_List,   only : List_clean => clean
+
+      use m_die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(SparseMatrixPlus), intent(in)  :: sMatPlus
+
+! !REVISION HISTORY:
+! 26Sep02 - Jay Larson <larson@mcs.anl.gov> - Implementation
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::initialized_'
+
+ integer :: XonlyLen, YonlyLen, XandYLen
+ type(List) :: XonlyList, YonlyList, XandYList, stratList
+
+  initialized_ = .FALSE.
+  
+  XonlyLen = len(trim(Xonly))
+  YonlyLen = len(trim(Yonly))
+  XandYLen = len(trim(XandY))
+  
+  if( (XonlyLen /= YonlyLen) .or. (XonlyLen /= XandYLen) ) then
+     call die(myname_,"The length of the strategies are unequal. &
+          &This routine needs to be rewritten.")
+  endif
+
+  if(associated(sMatPlus%strategy%c)) then
+     if(String_len(sMatPlus%strategy) == XonlyLen) then
+        call List_init(XonlyList,Xonly)
+        call List_init(YonlyList,Yonly)
+        call List_init(XandYList,XandY)
+        call List_init(stratList,sMatPlus%strategy)
+        if(List_identical(stratList,XonlyList)) initialized_ = .TRUE.
+        if(List_identical(stratList,YonlyList)) initialized_ = .TRUE.
+        if(List_identical(stratList,XandYList)) initialized_ = .TRUE.
+        call List_clean(XonlyList)
+        call List_clean(YonlyList)
+        call List_clean(XandYList)
+        call List_clean(stratList)
+     endif
+  endif
+
+ end function initialized_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportStrategyToChar - Return Parallelization Strategy
+!
+! !DESCRIPTION:
+! This query subroutine returns the parallelization  strategy set in 
+! the input {\tt SparseMatrixPlus} argument {\tt sMatPlus}.  The result
+! is returned in the output {\tt CHARACTER} argument {\tt StratChars}.
+!
+! !INTERFACE:
+
+ function exportStrategyToChar_(sMatPlus)
+!
+! !USES:
+!
+   use m_stdio
+   use m_die
+
+   use m_String, only : String_ToChar => toChar
+   use m_String, only : String_init => init
+   use m_String, only : String_clean => clean
+   use m_String, only : String
+
+   implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(SparseMatrixPlus), intent(in)  :: sMatPlus
+
+! !OUTPUT PARAMETERS: 
+!
+      character(len=size(sMatPlus%Strategy%c)) :: exportStrategyToChar_
+
+! !REVISION HISTORY:
+! 01Aug07 - Jay Larson <larson@mcs.anl.gov> - Implementation
+!EOP ___________________________________________________________________
+!
+ character(len=*),parameter :: myname_=myname//'::exportStrategyToChar_'
+ type(String) :: dummyStrategy ! SGI IR->WHIRL work-around
+
+   ! Check input argument to ensure it has been initialized.  If not,
+   ! signal an error and terminate execution.
+
+  if( .not. initialized_(sMatPlus) ) then
+     write(stderr,'(3a)') myname_,':: Warning, input argument not initialized, ', &
+          'returning empty character field for parallelization strategy.'
+     exportStrategyToChar_ = ' '
+     return
+  endif
+
+   ! Return in character form the parallelizaiton strategy
+  call String_init(dummyStrategy, SMatPlus%Strategy)
+
+  exportStrategyToChar_ = String_ToChar(dummyStrategy) 
+
+  call String_clean(dummyStrategy)
+
+ end function exportStrategyToChar_
+
+ end module m_SparseMatrixPlus
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixToMaps.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixToMaps.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SparseMatrixToMaps.F90	(revision 4775)
@@ -0,0 +1,456 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SparseMatrixToMaps.F90,v 1.13 2007-05-11 02:09:48 rloy Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SparseMatrixToMaps -- Maps from the Sparse Matrix 
+!
+! !DESCRIPTION:
+! The {\tt SparseMatrix} provides consolidated (on one process) or 
+! distributed sparse matrix storage for the operation
+! ${\bf y} = {\bf M} {\bf x}$, where {\bf x} and {\bf y} are vectors, 
+! and {\bf M} is a matrix.  In performing parallel matrix-vector 
+! multiplication, one has numerous options regarding the decomposition 
+! of the matrix {\bf M}, and the vectors {\bf y} and {\bf x}.
+! This module provides services to generate mct mapping components---the
+! {\tt GlobalMap} and {\tt GlobalSegMap} for the vectors {\bf y} and/or 
+! {\bf x} based on the decomposition of the sparse matrix {\bf M}.
+!
+! !INTERFACE:
+
+ module m_SparseMatrixToMaps
+!
+! !USES:
+!
+      use m_SparseMatrix, only : SparseMatrix
+
+      implicit none
+
+      private   ! except
+
+      public :: SparseMatrixToXGlobalSegMap
+      public :: SparseMatrixToYGlobalSegMap
+
+    interface SparseMatrixToXGlobalSegMap ; module procedure &
+	 SparseMatrixToXGlobalSegMap_
+    end interface
+
+    interface SparseMatrixToYGlobalSegMap ; module procedure &
+	 SparseMatrixToYGlobalSegMap_
+    end interface
+
+! !REVISION HISTORY:
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
+!           and API specifications.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SparseMatrixToMaps'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SparseMatrixToXGlobalSegMap_ - Generate X GlobalSegmap.
+!
+! !DESCRIPTION:  Given an input {\tt SparseMatrix} argument {\tt sMat},
+! this routine generates an output {\tt GlobalSegMap} variable 
+! {\tt xGSMap}, which describes the domain decomposition of the vector 
+! {\bf x} in the distributed matrix-vector multiplication 
+! $${\bf y} = {\bf M} {\bf x}.$$
+!
+! !INTERFACE:
+
+ subroutine SparseMatrixToXGlobalSegMap_(sMat, xGSMap, root, comm, comp_id)
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      use m_mpif90
+
+      use m_List, only : List
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_nCols => nCols
+      use m_SparseMatrix, only : SparseMatrix_lsize => lsize
+      use m_SparseMatrix, only : SparseMatrix_indexIA => indexIA
+      use m_SparseMatrix, only : SparseMatrix_SortPermute => SortPermute
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,            intent(in)    :: root    ! communicator root
+      integer,            intent(in)    :: comm    ! communicator handle
+      integer,            intent(in)    :: comp_id ! component id
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(SparseMatrix), intent(inout) :: sMat    ! input SparseMatrix
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GlobalSegMap), intent(out)   :: xGSMap  ! segmented decomposition
+                                                   ! for x
+! !REVISION HISTORY:
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 25Apr01 - J.W. Larson <larson@mcs.anl.gov> - First version.
+! 27Apr01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix--intent of
+!           argument sMat changed from (IN) to (INOUT)
+! 27Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - bug fix-- add use 
+!           statement for SortPermute
+! 01May01 - R.L. Jacob <jacob@mcs.anl.gov> - make comp_id an
+!           input argument
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SparseMatrixToXGlobalSegMap_'
+
+! SparseMatrix attributes:
+  integer :: lsize
+! GlobalSegMap input attributes:
+  integer :: gsize, ngseg
+  integer, dimension(:), pointer :: starts, lengths
+! Temporary array for identifying each matrix element column and 
+! process ID destination
+  integer, dimension(:), allocatable :: gCol, element_pe_locs 
+! Index to identify the gcol attribute in sMat:
+  integer :: igCol
+! Matrix element sorting keys list:
+  type(List) :: sort_keys
+! Loop index and error flag:
+  integer :: i, ierr
+
+       ! Determine he local number of matrix elements lsize
+
+  lsize = SparseMatrix_lsize(sMat)
+
+       ! The value of gsize is taken from the number of columns in sMat:
+
+  gsize = SparseMatrix_nCols(sMat)
+
+       ! Sort SparseMatrix entries by global column index gcol, then
+       ! global row index.
+
+       ! Create Sort keys list
+
+  call List_init(sort_keys,'gcol:grow')
+
+       ! Sort and permute the entries of sMat into lexicographic order
+       ! by global column, then global row.
+
+  call SparseMatrix_SortPermute(sMat, sort_keys)
+
+       ! Clean up sort keys list
+
+  call List_clean(sort_keys)
+
+       ! Allocate storage space for matrix element column indices and
+       ! process ID destinations
+
+  allocate(gCol(lsize), stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'allocate(gCol...',ierr)
+  endif
+
+       ! Extract global column information and place in array gCol
+
+  igCol = SparseMatrix_indexIA(sMat, 'gcol', dieWith=myname_)
+
+  do i=1, lsize
+     gCol(i) = sMat%data%iAttr(igCol,i)
+  end do
+
+       ! Scan sorted entries of gCol to count segments (ngseg), and
+       ! their starting indices and lengths (returned in the arrays
+       ! starts(:) and lengths(:), respectively)
+
+  call ComputeSegments_(gCol, lsize, ngseg, starts, lengths)
+
+       ! Now we have sufficient data to call the GlobalSegMap
+       ! initialization using distributed data:
+
+  call GlobalSegMap_init(xGSMap, starts, lengths, root, comm, &
+                         comp_id, gsize=gsize)
+  
+       ! clean up temporary arrays gCol(:), starts(:) and lengths(:),
+       ! (the latter two were allocated in the call to the routine
+       ! ComputeSegments_())
+
+  deallocate(gCol, starts, lengths, stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'deallocate(gCol...',ierr)
+  endif
+
+ end subroutine SparseMatrixToXGlobalSegMap_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SparseMatrixToYGlobalSegMap_ - Generate Y GlobalSegmap.
+!
+! !DESCRIPTION:  Given an input {\tt SparseMatrix} argument {\tt sMat},
+! this routine generates an output {\tt GlobalSegMap} variable 
+! {\tt yGSMap}, which describes the domain decomposition of the vector 
+! {\bf y} in the distributed matrix-vector multiplication 
+! ${\bf y} = {\bf M} {\bf x}$.
+!
+! !INTERFACE:
+
+ subroutine SparseMatrixToYGlobalSegMap_(sMat, yGSMap, root, comm, comp_id)
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : die
+
+      use m_List, only : List
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+
+      use m_SparseMatrix, only : SparseMatrix
+      use m_SparseMatrix, only : SparseMatrix_nRows => nRows
+      use m_SparseMatrix, only : SparseMatrix_lsize => lsize
+      use m_SparseMatrix, only : SparseMatrix_indexIA => indexIA
+      use m_SparseMatrix, only : SparseMatrix_SortPermute => SortPermute
+
+      use m_GlobalSegMap, only : GlobalSegMap
+      use m_GlobalSegMap, only : GlobalSegMap_init => init
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,            intent(in)    :: root    ! communicator root
+      integer,            intent(in)    :: comm    ! communicator handle
+      integer,            intent(in)    :: comp_id ! component id
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(SparseMatrix), intent(inout) :: sMat    ! input SparseMatrix
+
+! !OUTPUT PARAMETERS: 
+!
+      type(GlobalSegMap), intent(out)   :: yGSMap  ! segmented decomposition
+                                                   ! for y
+! !REVISION HISTORY:
+! 13Apr01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 25Apr01 - J.W. Larson <larson@mcs.anl.gov> - initial code.
+! 27Apr01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix--intent of
+!           argument sMat changed from (IN) to (INOUT)
+! 27Apr01 - R.L. Jacob <jacob@mcs.anl.gov> - bug fix-- add use 
+!           statement for SortPermute
+! 01May01 - R.L. Jacob <jacob@mcs.anl.gov> - make comp_id an
+!           input argument
+! 07May02 - J.W. Larson <larson@mcs.anl.gov> - Changed interface to
+!           make it consistent with SparseMatrixToXGlobalSegMap_().
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SparseMatrixToYGlobalSegMap_'
+
+! SparseMatrix attributes:
+  integer :: lsize
+! GlobalSegMap input attributes:
+  integer :: gsize, ngseg
+  integer, dimension(:), pointer :: starts, lengths
+! Temporary array for identifying each matrix element column and 
+! process ID destination
+  integer, dimension(:), allocatable :: gRow, element_pe_locs 
+! Index to identify the gRow attribute in sMat:
+  integer :: igRow
+! Matrix element sorting keys list:
+  type(List) :: sort_keys
+! Loop index and error flag:
+  integer :: i, ierr
+
+       ! Determine he local number of matrix elements lsize
+
+  lsize = SparseMatrix_lsize(sMat)
+
+       ! The value of gsize is taken from the number of columns in sMat:
+
+  gsize = SparseMatrix_nRows(sMat)
+
+       ! Sort SparseMatrix entries by global column index grow, then
+       ! global row index.
+
+       ! Create Sort keys list
+
+  call List_init(sort_keys,'grow:gcol')
+
+       ! Sort and permute the entries of sMat into lexicographic order
+       ! by global column, then global row.
+
+  call SparseMatrix_SortPermute(sMat, sort_keys)
+
+       ! Clean up sort keys list
+
+  call List_clean(sort_keys)
+
+       ! Allocate storage space for matrix element column indices and
+       ! process ID destinations
+
+  allocate(gRow(lsize), stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'allocate(gRow...',ierr)
+  endif
+
+       ! Extract global column information and place in array gRow
+
+  igRow = SparseMatrix_indexIA(sMat,'grow', dieWith=myname_)
+
+  do i=1, lsize
+     gRow(i) = sMat%data%iAttr(igRow,i)
+  end do
+
+       ! Scan sorted entries of gRow to count segments (ngseg), and
+       ! their starting indices and lengths (returned in the arrays
+       ! starts(:) and lengths(:), respectively)
+
+  call ComputeSegments_(gRow, lsize, ngseg, starts, lengths)
+
+       ! Now we have sufficient data to call the GlobalSegMap
+       ! initialization using distributed data:
+
+  call GlobalSegMap_init(yGSMap, starts, lengths, root, comm, &
+                         comp_id, gsize=gsize)
+  
+       ! clean up temporary arrays gRow(:), starts(:) and lengths(:),
+       ! (the latter two were allocated in the call to the routine
+       ! ComputeSegments_())
+
+  deallocate(gRow, starts, lengths, stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'deallocate(gRow...',ierr)
+  endif
+
+ end subroutine SparseMatrixToYGlobalSegMap_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: CreateSegments_ - Generate segment information.
+!
+! !DESCRIPTION:  This routine examines an input {\tt INTEGER} list of
+! numbers {\tt indices} (of length {\tt num\_indices}), determines the
+! number of segments of consecutive numbers (or runs) {\tt nsegs}.  The
+! starting indices for each run, and their lengths are returned in the 
+! {\tt INTEGER} arrays {\tt starts(:)} and {\tt lengths(:)}, respectively.
+!
+! !INTERFACE:
+
+ subroutine ComputeSegments_(indices, num_indices, nsegs, starts, lengths)
+
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : die
+
+      implicit none
+!
+! !INPUT PARAMETERS: 
+!
+
+      integer, dimension(:), intent(in)  :: indices
+      integer,               intent(in)  :: num_indices
+!
+! !OUTPUT PARAMETERS:
+!
+      integer,               intent(out) :: nsegs
+      integer, dimension(:), pointer     :: starts
+      integer, dimension(:), pointer     :: lengths
+
+
+! !REVISION HISTORY:
+! 19Apr01 - J.W. Larson <larson@mcs.anl.gov> - API specification.
+! 25Apr01 - J.W. Larson <larson@mcs.anl.gov> - Initial code.
+! 27Apr01 - J.W. Larson <larson@mcs.anl.gov> - Bug fix--error in
+!           computation of segment starts/lengths.
+! 27Nov01 - E.T. Ong <eong@mcs.anl.gov> - Bug fix--initialize
+!           nsegs=0 in case num_indices=0.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ComputeSegments_'
+
+  integer :: i, ierr
+
+       ! First pass:  count the segments
+
+  nsegs = 0
+
+  do i=1,num_indices
+
+     if(i == 1) then ! bootstrap segment counting process
+
+	nsegs = 1
+
+     else
+
+	if(indices(i) > indices(i-1) + 1) then ! new segment
+	   nsegs = nsegs + 1
+	endif
+
+     endif ! if(i==1)
+
+  end do ! do i=1, num_indices
+
+       ! Allocate storage space for starts(:) and lengths(:)
+
+  allocate(starts(nsegs), lengths(nsegs), stat=ierr)
+
+  if(ierr /= 0) then
+     call die(myname_,'allocate(starts...',ierr)
+  endif
+
+       ! Second pass:  compute segment start/length info
+
+  do i=1,num_indices
+
+     select case(i)
+     case(1)  ! bootstrap segment counting process
+	nsegs = 1
+	starts(nsegs) = indices(i)
+! rml patch
+        lengths(nsegs) = 1
+     case default
+
+	if(i == num_indices) then ! last point
+	   if(indices(i) > indices(i-1) + 1) then ! new segment with 1 pt.
+       ! first, close the books on the penultimate segment:
+	      lengths(nsegs) = indices(i-1) - starts(nsegs) + 1 
+	      nsegs = nsegs + 1
+	      starts(nsegs) = indices(i)
+	      lengths(nsegs) = 1  ! (just one point)
+	   else
+	      lengths(nsegs) = indices(i) - starts(nsegs) + 1
+	   endif
+	else
+	   if(indices(i) > indices(i-1) + 1) then ! new segment
+	      lengths(nsegs) = indices(i-1) - starts(nsegs) + 1
+	      nsegs = nsegs + 1
+	      starts(nsegs) = indices(i)
+	   endif
+	endif
+
+     end select ! select case(i)
+
+  end do ! do i=1, num_indices
+
+ end subroutine ComputeSegments_
+
+ end  module m_SparseMatrixToMaps
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegral.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegral.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegral.F90	(revision 4775)
@@ -0,0 +1,2034 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SpatialIntegral.F90,v 1.22 2008-05-12 01:59:33 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SpatialIntegral - Spatial Integrals and Averages using a GeneralGrid
+!
+! !DESCRIPTION:  This module provides spatial integration and averaging 
+! services for the MCT.  For a field $\Phi$ sampled at a point ${\bf x}$ 
+! in some multidimensional domain $\Omega$, the integral $I$ of 
+! $\Phi({\bf x})$ is
+! $$ I = \int_{\Omega} \Phi ({\bf x}) d\Omega .$$ 
+! The spatial average $A$ of $\Phi({\bf x})$ over $\Omega$ is
+! $$ A = {{ \int_{\Omega} \Phi ({\bf x}) d\Omega} \over 
+! { \int_{\Omega} d\Omega} }. $$
+! Since the {\tt AttrVect} represents a discretized field, the integrals 
+! above are implemented as:
+! $$ I = \sum_{i=1}^N \Phi_i \Delta \Omega_i $$
+! and 
+! $$ A = {{\sum_{i=1}^N \Phi_i \Delta \Omega_i } \over 
+!{\sum_{i=1}^N \Delta \Omega_i } }, $$
+! where $N$ is the number of physical locations, $\Phi_i$ is the value 
+! of the field $\Phi$ at location $i$, and $\Delta \Omega_i$ is the spatial 
+! weight (lenghth element, cross-sectional area element, volume element, 
+! {\em et cetera}) at location $i$.
+!
+! MCT extends the concept of integrals and area/volume averages to include 
+! {\em masked} integrals and averages.  MCT recognizes both {\em integer}
+! and {\em real} masks.  An integer mask $M$ is a vector of integers (one
+! corresponding to each physical location) with each element having value 
+! either zero or one.  Integer masks are used to include/exclude data from
+! averages or integrals.  For example, if one were to compute globally 
+! averaged cloud amount over land (but not ocean nor sea-ice), one would 
+! assign a $1$ to each location on the land and a $0$ to each non-land 
+! location.  A {\em real} mask $F$ is a vector of real numbers (one corresponding 
+! to each physical location) with each element having value within the 
+! closed interval $[0,1]$.  .Real masks are used to represent fractional 
+! area/volume coverage at a location by a given component model.  For 
+! example, if one wishes to compute area averages over sea-ice, one must 
+! include the ice fraction present at each point.  Masked Integrals and 
+! averages are represented in the MCT by:
+! $$ I = \sum_{i=1}^N {\prod_{j=1}^J M_i} {\prod_{k=1}^K F_i} 
+! \Phi_i \Delta \Omega_i $$
+! and 
+! $$ A = {{\sum_{i=1}^N \bigg({\prod_{j=1}^J M_i}\bigg) \bigg( {\prod_{k=1}^K F_i}
+! \bigg) \Phi_i 
+! \Delta \Omega_i } \over 
+!{\sum_{i=1}^N \bigg({\prod_{j=1}^J M_i}\bigg) \bigg( {\prod_{k=1}^K F_i} \bigg) 
+!  \Delta \Omega_i } }, $$
+! where $J$ is the number of integer masks and $K$ is the number of real masks.
+!
+! All of the routines in this module assume field data is stored in an 
+! attribute vector ({\tt AttrVect}), and the integration/averaging is performed 
+! only on the {\tt REAL} attributes.  Physical coordinate grid and mask 
+! information is assumed to be stored as attributes in either a 
+! {\tt GeneralGrid}, or pre-combined into a single integer mask and a single 
+! real mask.  
+!
+! !INTERFACE:
+
+ module m_SpatialIntegral
+     
+      implicit none
+
+      private	! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: SpatialIntegral        ! Spatial Integral
+      public :: SpatialAverage         ! Spatial Area Average
+
+      public :: MaskedSpatialIntegral  ! Masked Spatial Integral
+      public :: MaskedSpatialAverage   ! MaskedSpatial Area Average
+
+      public :: PairedSpatialIntegrals ! A Pair of Spatial 
+                                      ! Integrals 
+
+      public :: PairedSpatialAverages  ! A Pair of Spatial 
+                                      ! Area Averages
+
+      public :: PairedMaskedSpatialIntegrals ! A Pair of Masked
+                                             ! Spatial Integrals 
+
+      public :: PairedMaskedSpatialAverages ! A Pair of Masked
+                                            ! Spatial Area Averages
+
+      interface SpatialIntegral ; module procedure &
+	   SpatialIntegralRAttrGG_
+      end interface
+      interface SpatialAverage ; module procedure &
+	   SpatialAverageRAttrGG_ 
+      end interface
+      interface MaskedSpatialIntegral ; module procedure &
+	   MaskedSpatialIntegralRAttrGG_
+      end interface
+      interface MaskedSpatialAverage ; module procedure &
+	   MaskedSpatialAverageRAttrGG_
+      end interface
+      interface PairedSpatialIntegrals ; module procedure &
+	    PairedSpatialIntegralRAttrGG_
+      end interface
+      interface PairedSpatialAverages ; module procedure &
+	    PairedSpatialAverageRAttrGG_
+      end interface
+      interface PairedMaskedSpatialIntegrals ; module procedure &
+	    PairedMaskedIntegralRAttrGG_
+      end interface
+      interface PairedMaskedSpatialAverages ; module procedure &
+	    PairedMaskedAverageRAttrGG_
+      end interface
+
+! !REVISION HISTORY:
+! 	25Oct01 - J.W. Larson <larson@mcs.anl.gov> - Initial version
+!        9May02 - J.W. Larson <larson@mcs.anl.gov> - Massive Refactoring.
+!    10-14Jun02 - J.W. Larson <larson@mcs.anl.gov> - Added Masked methods.
+!    17-18Jun02 - J.W. Larson <larson@mcs.anl.gov> - Added Paired/Masked 
+!                 methods.
+!       18Jun02 - J.W. Larson <larson@mcs.anl.gov> - Renamed module from 
+!                 m_GlobalIntegral to m_SpatialIntegral.
+!       15Jan03 - E.T. Ong <eong@mcs.anl.gov> - Initialized real-only 
+!                 AttrVects using nullfied integer lists. This circuitous 
+!                 hack was required because the compaq compiler does not
+!                 compile the function AttrVectExportListToChar. 
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SpatialIntegral'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialIntegralRAttrGG_ - Compute spatial integral.
+!
+! !DESCRIPTION:
+! This routine computes spatial integrals of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} argument 
+! {\tt inAv}.  {\tt SpatialIntegralRAttrGG\_()} takes the input 
+! {\tt AttrVect} argument {\tt inAv} and computes the spatial 
+! integral using weights stored in the {\tt GeneralGrid} argument 
+! {\tt GGrid} and identified by the {\tt CHARACTER} tag {\tt WeightTag}.  
+! The integral of each {\tt REAL} attribute is returned in the output 
+! {\tt AttrVect} argument {\tt outAv}. If {\tt SpatialIntegralRAttrGG\_()} 
+! is invoked with the optional {\tt LOGICAL} input argument 
+! {\tt SumWeights} set as {\tt .TRUE.}, then the weights are also summed 
+! and stored in {\tt outAv} (and can be referenced with the attribute 
+! tag defined by the argument{\tt WeightTag}.  If 
+! {\tt SpatialIntegralRAttrGG\_()} is invoked with the optional {\tt INTEGER} 
+! argument {\tt comm} (a Fortran MPI communicator handle), the summation
+! operations for the integral are completed on the local process, then 
+! reduced across the communicator, with all processes receiving the result.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the {\tt GeneralGrid} {\tt GGrid} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt GGrid}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrGG\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}, 
+! then the value of {\tt WeightTag} must not conflict with any of the 
+! {\tt REAL} attribute tags in {\tt inAv}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine SpatialIntegralRAttrGG_(inAv, outAv, GGrid, WeightTag, &
+                                   SumWeights, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_SpatialIntegralV, only: SpatialIntegralV
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),    intent(IN) :: inAv
+      type(GeneralGrid), intent(IN) :: GGrid
+      character(len=*),  intent(IN) :: WeightTag
+      logical, optional, intent(IN) :: SumWeights
+      integer, optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	06Feb02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! 	09May02 - J.W. Larson <larson@mcs.anl.gov> - Refactored and
+!                 renamed SpatialIntegralRAttrGG_().
+!       07Jun02 - J.W. Larson <larson@mcs.anl.gov> - Bug fix and further
+!                 refactoring.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialIntegralRAttrGG_'
+
+  integer :: ierr, length
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: gridWeights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= GeneralGrid_lsize(GGrid)) then
+     ierr = AttrVect_lsize(inAv) - GeneralGrid_lsize(GGrid)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / GGrid length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' GeneralGrid_lsize(GGrid) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! ensure unambiguous pointer association status for gridWeights
+
+  nullify(gridWeights) 
+
+       ! Extract Grid Weights
+
+  call GeneralGrid_exportRAttr(GGrid, WeightTag, gridWeights, length)
+
+       ! 
+
+  if(present(comm)) then ! do a distributed AllReduce-style integral:
+     call SpatialIntegralV(inAv, outAv, gridWeights, mySumWeights, &
+	                        WeightTag, comm)
+  else
+     call SpatialIntegralV(inAv, outAv, gridWeights, mySumWeights, &
+                                WeightTag)
+  endif
+
+       ! Clean up temporary allocated space
+
+  deallocate(gridWeights, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	              ':: deallocate(gridWeights...failed.  ierr=', ierr
+     call die(myname_)
+  endif
+
+ end subroutine SpatialIntegralRAttrGG_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialAverageRAttrGG_ - Compute spatial average.
+!
+! !DESCRIPTION:
+! This routine computes spatial averages of the {\tt REAL} attributes
+! of the input {\tt AttrVect} argument {\tt inAv}.  
+! {\tt SpatialAverageRAttrGG\_()} takes the input {\tt AttrVect} argument 
+! {\tt inAv} and computes the spatial average using weights 
+! stored in the {\tt GeneralGrid} argument {\tt GGrid} and identified by
+! the {\tt CHARACTER} tag {\tt WeightTag}.  The average of each {\tt REAL}
+! attribute is returned in the output {\tt AttrVect} argument {\tt outAv}.
+! If {\tt SpatialAverageRAttrGG\_()} is invoked with the optional {\tt INTEGER} 
+! argument {\tt comm} (a Fortran MPI communicator handle), the summation
+! operations for the average are completed on the local process, then 
+! reduced across the communicator, with all processes receiving the result.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the {\tt GeneralGrid} {\tt GGrid} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt GGrid}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine SpatialAverageRAttrGG_(inAv, outAv, GGrid, WeightTag, comm)
+
+! ! USES:
+
+      use m_realkinds, only : FP
+   
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero 
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_GeneralGrid, only : GeneralGrid
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),    intent(IN) :: inAv
+      type(GeneralGrid), intent(IN) :: GGrid
+      character(len=*),  intent(IN) :: WeightTag
+      integer, optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	08Feb02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! 	08May02 - J.W. Larson <larson@mcs.anl.gov> - minor modifications:
+!                 1) renamed the routine to GlobalAverageRAttrGG_
+!                 2) changed calls to reflect new routine name
+!                    GlobalIntegralRAttrGG_().
+!       18Jun02 - J.W. Larson <larson@mcs.anl.gov> - Renamed routine to
+!                 SpatialAverageRAttrGG_().
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialAverageRAtttrGG_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+  integer :: i, ierr, iweight
+
+       ! Compute the spatial integral:
+
+  if(present(comm)) then
+     call SpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, WeightTag, &
+	                         .TRUE., comm)
+  else
+     call SpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, WeightTag, &
+	                         .TRUE.)
+  endif
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, WeightTag)
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine SpatialAverageRAttrGG_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialIntegralRAttrGG_ - Masked spatial integral.
+!
+! !DESCRIPTION: 
+! This routine computes masked spatial integrals of the {\tt REAL} 
+! attributes of the input {\tt AttrVect} argument {\tt inAv}, returning 
+! the masked integrals in the output {\tt AttrVect} {\tt outAv}.  All of 
+! the masking data are assumed stored in the input {\tt GeneralGrid} 
+! argument {\tt GGrid}.  If integer masks are to be used, their integer 
+! attribute names in {\tt GGrid} are named as a colon-delimited list 
+! in the optional {\tt CHARACTER} input argument {\tt iMaskTags}.  Real 
+! masks (if desired) are referenced by their real attribute names in 
+! {\tt GGrid} are named as a colon-delimited list in the optional 
+! {\tt CHARACTER} input argument {\tt rMaskTags}.  The user specifies 
+! a choice of mask combination method with the input {\tt LOGICAL} argument
+! {\tt UseFastMethod}.  If ${\tt UseFastMethod} = {\tt .FALSE.}$ this 
+! routine checks each mask entry to ensure that the integer masks contain
+! only ones and zeroes, and that entries in the real masks are all in
+! the closed interval $[0,1]$.  If ${\tt UseFastMethod} = {\tt .TRUE.}$,
+! this routine performs direct products of the masks, assuming that the
+! user has validated them in advance.  The optional {\tt LOGICAL} input 
+! argument {\tt SumWeights} determines whether the masked sum of the spatial
+! weights is computed and returned in {\tt outAv} with the real attribute 
+! name supplied in the optional {\tt CHARACTER} input argument 
+! {\tt WeightSumTag}.  This integral can either be a local (i.e. a global 
+! memory space operation), or a global distributed integral.  The latter 
+! is the case if the optional input {\tt INTEGER} argument {\tt comm} is
+! supplied (which corresponds to a Fortran MPI communicatior handle).
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input {\tt GeneralGrid} {\tt GGrid} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt GGrid}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}. 
+! In this case, the none of {\tt REAL} attribute tags in {\tt inAv} may be 
+! named the same as the string contained in {\tt WeightSumTag}, which is an 
+! attribute name reserved for the sum of the weights in the output {\tt AttrVect} 
+! {\tt outAv}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialIntegralRAttrGG_(inAv, outAv, GGrid, SpatialWeightTag, &
+                                         iMaskTags, rMaskTags, UseFastMethod,  &
+                                         SumWeights, WeightSumTag, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : FP
+
+      use m_String, only : String
+      use m_String, only : String_toChar => toChar
+      use m_String, only : String_clean => clean
+
+      use m_List, only : List
+      use m_List, only : List_init => init
+      use m_List, only : List_clean => clean
+      use m_List, only : List_nitem => nitem
+      use m_List, only : List_get => get
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportIAttr => exportIAttr
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_AttrVectReduce, only : AttrVect_GlobalWeightedSumRAttr => &
+	                                         GlobalWeightedSumRAttr
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_SpatialIntegralV, only : MaskedSpatialIntegralV
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      type(GeneralGrid),               intent(IN) :: GGrid
+      character(len=*),                intent(IN) :: SpatialWeightTag
+      character(len=*),      optional, intent(IN) :: iMaskTags
+      character(len=*),      optional, intent(IN) :: rMaskTags
+      logical,                         intent(IN) :: UseFastMethod
+      logical,               optional, intent(IN) :: SumWeights
+      character(len=*),      optional, intent(IN) :: WeightSumTag
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	11Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialIntegralRAttrGG_'
+
+  integer :: i, ierr, j, length
+  logical :: mySumWeights
+
+  type(List) :: iMaskList, rMaskList
+  type(String) :: DummStr
+
+  integer, dimension(:), pointer :: iMask, iMaskTemp
+  real(FP), dimension(:), pointer :: rMask, rMaskTemp
+  integer :: TempMaskLength
+
+  real(FP), dimension(:), pointer :: SpatialWeights
+
+  integer :: niM, nrM ! Number of iMasks and rMasks, respectively
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= GeneralGrid_lsize(GGrid)) then
+     ierr = AttrVect_lsize(inAv) - GeneralGrid_lsize(GGrid)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / GGrid length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' GeneralGrid_lsize(GGrid) = ',GeneralGrid_lsize(GGrid)
+     call die(myname_)
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+     if(.not. present(WeightSumTag)) then
+	write(stderr,'(3a)') myname_,':: FATAL--If the input argument SumWeights=.TRUE.,', &
+                        ' then the argument WeightSumTag must be provided.'
+	call die(myname_)
+     endif
+  else
+     mySumWeights = .FALSE.
+  endif
+
+  if(present(iMaskTags)) then
+     call List_init(iMaskList, iMaskTags)
+     if(List_nitem(iMaskList) == 0) then
+	write(stderr,'(3a)') myname_,':: ERROR--an INTEGER mask list with', &
+	               'no valid items was provided.'
+        call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags)) then
+     call List_init(rMaskList, rMaskTags)
+     if(List_nitem(iMaskList) == 0) then
+	write(stderr,'(3a)') myname_,':: ERROR--an REAL mask list with', &
+	               'no valid items was provided.'
+        call die(myname_)
+     endif
+  endif
+
+       ! Determine the on-processor vector length for use throughout
+       ! this routine:
+
+  length = AttrVect_lsize(inAv)
+
+       !==========================================================
+       ! Extract Spatial Weights from GGrid using SpatialWeightTag
+       !==========================================================
+
+  nullify(SpatialWeights)
+  call GeneralGrid_exportRAttr(GGrid, SpatialWeightTag, SpatialWeights, &
+                               TempMaskLength)
+  if(TempMaskLength /= length) then
+     write(stderr,'(3a,i8,a,i8)') myname_,&
+	  ':: error on return from GeneralGrid_exportRAttr().' , &   
+	  'Returned with SpatialWeights(:) length = ',TempMaskLength, &
+	  ',which conflicts with AttrVect_lsize(inAv) = ',length
+     call die(myname_)
+  endif
+
+       !==========================================================
+       ! If the argument iMaskTags is present, create the combined
+       ! iMask array:
+       !==========================================================
+
+  if(present(iMaskTags)) then ! assemble iMask(:) from all the integer
+                              ! mask attributes stored in GGrid(:)
+
+     allocate(iMask(length), iMaskTemp(length), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(3a,i8)') myname_,':: allocate(iMask(...) failed,', &
+	     ' ierr=',ierr
+	call die(myname_)
+     endif
+
+     niM = List_nitem(iMaskList)
+
+     do i=1,niM
+
+       ! Retrieve current iMask tag, and get this attribute from GGrid:
+	call List_get(DummStr, i, iMaskList)
+	call GeneralGrid_exportIAttr(GGrid, String_toChar(DummStr), &
+	                             iMaskTemp, TempMaskLength)
+	call String_clean(DummStr)
+	if(TempMaskLength /= length) then
+	   write(stderr,'(3a,i8,a,i8)') myname_,&
+		 ':: error on return from GeneralGrid_exportIAttr().' , &   
+		 'Returned with TempMaskLength = ',TempMaskLength, &
+		 ',which conflicts with AttrVect_lsize(inAv) = ',length
+	   call die(myname_)
+	endif
+
+	if(i == 1) then ! first pass--examine iMaskTemp(:) only
+
+	   if(UseFastMethod) then ! straight copy of iMaskTemp(:)
+	      do j=1,length
+		 iMask(j) = iMaskTemp(j)
+	      end do
+	   else ! go through the entries of iMaskTemp(:) one-by-one
+	      do j=1,length
+		 select case(iMaskTemp(j))
+		 case(0)
+		    iMask(j) = 0
+		 case(1)
+		    iMask(j) = 1
+		 case default
+		    write(stderr,'(3a,i8,a,i8)') myname_, &
+			 ':: FATAL--illegal INTEGER mask entry.  Integer mask ', &
+			 'entries must be 0 or 1.  iMask(',j,') = ', iMask(j)
+		    call die(myname_)
+		 end select ! select case(iMaskTemp(j))...
+	      end do ! do j=1,length
+	   endif ! if(UseFastMethod)...
+
+	else ! That is, i /= 1 ...
+
+	   if(UseFastMethod) then ! straight product of iMask(:) 
+                                  ! and iMaskTemp(:)
+	      do j=1,length
+		 iMask(j) = iMask(j) * iMaskTemp(j)
+	      end do
+	   else ! go through the entries of iMaskTemp(:) one-by-one
+	      do j=1,length
+		 select case(iMaskTemp(j))
+		 case(0) ! zero out iMask(j)
+		    iMask(j) = 0
+		 case(1) ! do nothing
+		 case default
+		    write(stderr,'(3a,i8,a,i8)') myname_, &
+			 ':: FATAL--illegal INTEGER mask entry.  Integer mask ', &
+			 'entries must be 0 or 1.  iMask(',j,') = ', iMask(j)
+		    call die(myname_)
+		 end select ! select case(iMaskTemp(j))...
+	      end do ! do j=1,length
+	   endif ! if(UseFastMethod)...
+
+	endif ! if(i == 1)...
+
+     end do ! do i=1,niM...iMask retrievals
+
+  endif ! if(present(iMaskTags))...
+
+       !==========================================================
+       ! If the argument rMaskTags is present, create the combined
+       ! REAL mask rMask array:
+       !==========================================================
+
+  if(present(rMaskTags)) then ! assemble rMask(:) from all the integer
+                              ! mask attributes stored in GGrid(:)
+
+     allocate(rMask(length), rMaskTemp(length), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(3a,i8)') myname_,':: allocate(rMask(...) failed,', &
+	     ' ierr=',ierr
+	call die(myname_)
+     endif
+
+     nrM = List_nitem(rMaskList)
+
+     do i=1,nrM
+
+       ! Retrieve current rMask tag, and get this attribute from GGrid:
+	call List_get(DummStr, i, rMaskList)
+	call GeneralGrid_exportRAttr(GGrid, String_toChar(DummStr), &
+	                             rMaskTemp, TempMaskLength)
+	call String_clean(DummStr)
+	if(TempMaskLength /= length) then
+	   write(stderr,'(3a,i8,a,i8)') myname_,&
+		 ':: error on return from GeneralGrid_exportRAttr().' , &   
+		 'Returned with TempMaskLength = ',TempMaskLength, &
+		 ',which conflicts with AttrVect_lsize(inAv) = ',length
+	   call die(myname_)
+	endif
+
+	if(i == 1) then ! first pass--examine rMaskTemp(:) only
+
+	   if(UseFastMethod) then ! straight copy of rMaskTemp(:)
+	      do j=1,length
+		 rMask(j) = rMaskTemp(j)
+	      end do
+	   else ! go through the entries of rMaskTemp(:) one-by-one
+                ! to ensure they are in the range [0.,1.]
+	      do j=1,length
+		 if((rMaskTemp(j) >= 0.) .or. (rMaskTemp(j) <=1.)) then
+		    rMask(j) = rMaskTemp(j)
+		 else
+		    write(stderr,'(3a,i8,a,i8)') myname_, &
+			 ':: FATAL--illegal REAL mask entry.  Real mask ', &
+			 'entries must be in [0.,1.]  rMask(',j,') = ', rMask(j)
+		    call die(myname_)
+		 endif ! if((rMaskTemp(j) >= 0.) .or. (rMaskTemp(j) <=1.))...
+	      end do ! do j=1,length
+	   endif ! if(UseFastMethod)...
+
+	else ! That is, i /= 1 ...
+
+	   if(UseFastMethod) then ! straight product of rMask(:) 
+                                  ! and rMaskTemp(:)
+	      do j=1,length
+		 rMask(j) = rMask(j) * rMaskTemp(j)
+	      end do
+	   else ! go through the entries of rMaskTemp(:) one-by-one
+                ! to ensure they are in the range [0.,1.]
+	      do j=1,length
+		 if((rMaskTemp(j) >= 0.) .or. (rMaskTemp(j) <=1.)) then
+		    rMask(j) = rMask(j) * rMaskTemp(j)
+		 else
+		    write(stderr,'(3a,i8,a,i8)') myname_, &
+			 ':: FATAL--illegal REAL mask entry.  Real mask ', &
+			 'entries must be in [0.,1.]  rMask(',j,') = ', rMask(j)
+		    call die(myname_)
+		 endif ! if((rMaskTemp(j) >= 0.) .or. (rMaskTemp(j) <=1.))...
+	      end do ! do j=1,length
+	   endif ! if(UseFastMethod)...
+
+	endif ! if(i == 1)...
+
+     end do ! do i=1,niM...rMask retrievals
+
+  endif ! if(present(rMaskTags))...
+
+       !==========================================================
+       ! Now that we have produced single INTEGER and REAL masks,
+       ! compute the masked weighted sum.
+       !==========================================================
+
+  if(present(rMaskTags)) then ! We have a REAL Mask
+
+     if(present(iMaskTags)) then ! and an INTEGER Mask
+
+	if(present(comm)) then ! compute distributed AllReduce-style sum:
+	   
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask, rMask, UseFastMethod, &
+					       SumWeights, WeightSumTag, comm)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask, rMask, UseFastMethod, &
+					       comm=comm)
+	   endif ! if(mySumWeights)...
+
+	else ! compute local sum:
+
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask, rMask, UseFastMethod, &
+					       SumWeights, WeightSumTag)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask, rMask, UseFastMethod)
+	   endif ! if(mySumWeights)...
+
+	endif ! if(present(comm))...
+
+     else ! REAL Mask Only Case...
+
+	if(present(comm)) then ! compute distributed AllReduce-style sum:
+	   
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               rMask=rMask, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag, &
+					       comm=comm)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               rMask=rMask, &
+					       UseFastMethod=UseFastMethod, &
+					       comm=comm)
+	   endif ! if(mySumWeights)...
+
+	else ! compute local sum:
+
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               rMask=rMask, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               rMask=rMask, &
+					       UseFastMethod=UseFastMethod)
+	   endif ! if(mySumWeights)...
+
+	endif ! if(present(comm))...
+
+     endif
+  else ! no REAL Mask...
+
+     if(present(iMaskTags)) then ! INTEGER Mask Only Case...
+
+	if(present(comm)) then ! compute distributed AllReduce-style sum:
+	   
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask=iMask, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag, &
+					       comm=comm)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask=iMask, &
+					       UseFastMethod=UseFastMethod, &
+					       comm=comm)
+	   endif ! if(mySumWeights)...
+
+	else ! compute local sum:
+
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask=iMask, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+		                               iMask=iMask, &
+					       UseFastMethod=UseFastMethod)
+	   endif ! if(mySumWeights)...
+
+	endif ! if(present(comm))...
+
+     else ! no INTEGER Mask / no REAL Mask Case...
+
+	if(present(comm)) then ! compute distributed AllReduce-style sum:
+	   
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag, &
+					       comm=comm)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+					       UseFastMethod=UseFastMethod, &
+					       comm=comm)
+	   endif ! if(mySumWeights)...
+
+	else ! compute local sum:
+
+	   if(mySumWeights) then ! return the global masked sum of the 
+                                 ! weights in outAV
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+					       UseFastMethod=UseFastMethod, &
+					       SumWeights=SumWeights, &
+					       WeightSumTag=WeightSumTag)
+	   else ! Do not return the masked sum of the weights
+	      call MaskedSpatialIntegralV(inAv, outAv, SpatialWeights, &
+					       UseFastMethod=UseFastMethod)
+	   endif ! if(mySumWeights)...
+
+	endif ! if(present(comm))...
+
+     endif ! if(present(iMaskTags)...
+
+  endif ! if(present(rMaskTags)...
+
+       !==========================================================
+       ! The masked spatial integral is now completed.
+       ! Clean up the the various allocated mask structures.
+       !==========================================================
+
+  if(present(iMaskTags)) then ! clean up iMask and friends...
+     call List_clean(iMaskList)
+     deallocate(iMask, iMaskTemp, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(3a,i8)') myname_,':: deallocate(iMask(...) failed,', &
+	     ' ierr=',ierr
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMaskTags)) then ! clean up rMask and co...
+     call List_clean(rMaskList)
+     deallocate(rMask, rMaskTemp, stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(3a,i8)') myname_,':: deallocate(rMask(...) failed,', &
+	     ' ierr=',ierr
+	call die(myname_)
+     endif
+  endif
+
+       ! Clean up SpatialWeights(:)
+
+  deallocate(SpatialWeights, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_,':: deallocate(SpatialWeights(...) failed,', &
+	                    ' ierr=',ierr
+     call die(myname_)
+  endif
+
+ end subroutine MaskedSpatialIntegralRAttrGG_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialAverageRAttrGG_ - Masked spatial average.
+!
+! !DESCRIPTION: 
+! This routine computes masked spatial averages of the {\tt REAL} 
+! attributes of the input {\tt AttrVect} argument {\tt inAv}, returning 
+! the masked averages in the output {\tt AttrVect} {\tt outAv}.  All of 
+! the masking data are assumed stored in the input {\tt GeneralGrid} 
+! argument {\tt GGrid}.  If integer masks are to be used, their integer 
+! attribute names in {\tt GGrid} are named as a colon-delimited list 
+! in the optional {\tt CHARACTER} input argument {\tt iMaskTags}.  Real 
+! masks (if desired) are referenced by their real attribute names in 
+! {\tt GGrid} are named as a colon-delimited list in the optional 
+! {\tt CHARACTER} input argument {\tt rMaskTags}.  The user specifies 
+! a choice of mask combination method with the input {\tt LOGICAL} argument
+! {\tt UseFastMethod}.  If ${\tt UseFastMethod} = {\tt .FALSE.}$ this 
+! routine checks each mask entry to ensure that the integer masks contain
+! only ones and zeroes, and that entries in the real masks are all in
+! the closed interval $[0,1]$.  If ${\tt UseFastMethod} = {\tt .TRUE.}$,
+! this routine performs direct products of the masks, assuming that the
+! user has validated them in advance.  This averaging can either be a 
+! local (equivalent to a global memory space operation), or a global 
+! distributed integral.  The latter is the case if the optional input 
+! {\tt INTEGER} argument {\tt comm} is supplied (which corresponds to a 
+! Fortran MPI communicatior handle).
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input {\tt GeneralGrid} {\tt GGrid} must be equal.  That is, 
+! there must be a one-to-one correspondence between the field point values 
+! stored in {\tt inAv} and the point weights stored in {\tt GGrid}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialAverageRAttrGG_(inAv, outAv, GGrid, SpatialWeightTag, &
+                                        iMaskTags, rMaskTags, UseFastMethod,  &
+  				        comm)
+
+! ! USES:
+
+      use m_realkinds, only : FP
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero 
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      type(GeneralGrid),               intent(IN) :: GGrid
+      character(len=*),                intent(IN) :: SpatialWeightTag
+      character(len=*),      optional, intent(IN) :: iMaskTags
+      character(len=*),      optional, intent(IN) :: rMaskTags
+      logical,                         intent(IN) :: UseFastMethod
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	12Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialAverageRAttrGG_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+  character*9, parameter :: WeightSumTag = 'WeightSum'
+
+  integer :: i, iweight
+
+       !================================================================
+       ! Do the integration using MaskedSpatialIntegralRAttrGG_(), which
+       ! returns the intermediate integrals (including the masked weight
+       ! sum) in the AttrVect integratedAv.
+       !================================================================
+
+  if(present(iMaskTags)) then
+
+     if(present(rMaskTags)) then ! have both iMasks and rMasks
+
+	if(present(comm)) then ! a distributed parallel sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, iMaskTags, &
+					     rMaskTags, UseFastMethod,  &
+					     .TRUE., WeightSumTag, comm)
+	else ! a purely local sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, iMaskTags, &
+					     rMaskTags, UseFastMethod,  &
+					     .TRUE., WeightSumTag)
+	endif ! if(present(comm))...
+
+     else ! Only iMasks are in use
+
+	if(present(comm)) then ! a distributed parallel sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, iMaskTags, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag, &
+					     comm=comm)
+
+	else ! a purely local sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, iMaskTags, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag)
+	endif ! if(present(comm))...
+
+     endif ! if(present(rMaskTags)...
+
+  else ! no iMasks
+
+     if(present(rMaskTags)) then ! Only rMasks are in use
+
+	if(present(comm)) then ! a distributed parallel sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, &
+					     rMaskTags=rMaskTags, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag, &
+					     comm=comm)
+	else ! a purely local sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, &
+					     rMaskTags=rMaskTags, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag)
+	endif
+
+     else ! Neither iMasks nor rMasks are in use
+
+	if(present(comm)) then ! a distributed parallel sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag, &
+					     comm=comm)
+	else ! a purely local sum
+	   call MaskedSpatialIntegralRAttrGG_(inAv, integratedAv, GGrid, &
+		                             SpatialWeightTag, &
+					     UseFastMethod=UseFastMethod,  &
+					     SumWeights=.TRUE., &
+					     WeightSumTag=WeightSumTag)
+	endif ! if(present(comm))...
+
+     endif ! if(present(rMaskTags))...
+
+  endif ! if(present(iMaskTags))...
+
+       !================================================================
+       ! The masked integrals and masked weight sum now reside in 
+       ! in the AttrVect integratedAv.  We now wish to compute the
+       ! averages by dividing the integtrals by the masked weight sum.
+       !================================================================
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, WeightSumTag)
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine MaskedSpatialAverageRAttrGG_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialIntegralRAttrGG_ - Do two spatial integrals at once.
+!
+! !DESCRIPTION:
+! This routine computes spatial integrals of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} arguments 
+! {\tt inAv1} and {\tt inAv2}, returning the integrals in the output 
+! {\tt AttrVect} arguments {\tt outAv1} and {\tt outAv2}, respectively .  
+! The integrals of {\tt inAv1} and {\tt inAv2} are computed using 
+! spatial weights stored in the input {\tt GeneralGrid} arguments  
+! {\tt GGrid1} and {\tt GGrid2}, respectively.  The spatial weights in 
+! in {\tt GGrid1} and {\tt GGrid2} are identified by the input {\tt CHARACTER} 
+! arguments {\tt WeightTag1} and {\tt WeightTag2}, respectively.  
+! If {\tt SpatialIntegralRAttrGG\_()} is invoked with the optional 
+! {\tt LOGICAL} input argument 
+! {\tt SumWeights} set as {\tt .TRUE.}, then the weights are also summed 
+! and stored in {\tt outAv1} and {\tt outAv2}, and can be referenced with 
+! the attribute tags defined by the arguments {\tt WeightTag1} and 
+! {\tt WeightTag2}, respectively.  This paired integral is implicitly a 
+! distributed operation (the whole motivation for pairing the integrals is 
+! to reduce communication latency costs), and the Fortran MPI communicator
+! handle is defined by the input {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the {\tt GeneralGrid} {\tt GGrid1} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the point weights stored in {\tt GGrid1}.  The same
+! relationship must apply between {\tt inAv2} and {\tt GGrid2}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrGG\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}, 
+! then the value of {\tt WeightTag1} must not conflict with any of the 
+! {\tt REAL} attribute tags in {\tt inAv1} and the value of {\tt WeightTag2} 
+! must not conflict with any of the {\tt REAL} attribute tags in {\tt inAv2}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialIntegralRAttrGG_(inAv1, outAv1, GGrid1, WeightTag1, &
+                                         inAv2, outAv2, GGrid2, WeightTag2, &
+					 SumWeights, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_SpatialIntegralV, only : PairedSpatialIntegralsV
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),    intent(IN) :: inAv1
+      type(GeneralGrid), intent(IN) :: GGrid1
+      character(len=*),  intent(IN) :: WeightTag1
+      type(AttrVect),    intent(IN) :: inAv2
+      type(GeneralGrid), intent(IN) :: GGrid2
+      character(len=*),  intent(IN) :: WeightTag2
+      logical, optional, intent(IN) :: SumWeights
+      integer,           intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	09May02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - Refactored--now
+!                 built on top of PairedIntegralRAttrV_().
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialIntegralRAttrGG_'
+
+       ! Argument Sanity Checks:
+
+  integer :: ierr, length1, length2
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: gridWeights1, gridWeights2
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid1)) then
+     ierr = AttrVect_lsize(inAv1) - GeneralGrid_lsize(GGrid1)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv1 / GGrid1 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  ' GeneralGrid_lsize(GGrid1) = ',GeneralGrid_lsize(GGrid1)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= GeneralGrid_lsize(GGrid2)) then
+     ierr = AttrVect_lsize(inAv2) - GeneralGrid_lsize(GGrid2)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv2 / GGrid2 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  ' GeneralGrid_lsize(GGrid2) = ',GeneralGrid_lsize(GGrid2)
+     call die(myname_)
+  endif
+
+        ! Are we summing the integration weights for either input
+        ! GeneralGrid?
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! ensure unambiguous pointer association status for gridWeights1
+       ! and gridWeights2
+
+  nullify(gridWeights1) 
+  nullify(gridWeights2) 
+
+       ! Extract Grid Weights
+
+  call GeneralGrid_exportRAttr(GGrid1, WeightTag1, gridWeights1, length1)
+  call GeneralGrid_exportRAttr(GGrid2, WeightTag2, gridWeights2, length2)
+
+
+  call PairedSpatialIntegralsV(inAv1, outAv1, gridweights1, WeightTag1, &
+	                           inAv2, outAv2, gridweights2, WeightTag2, &
+                                   mySumWeights, comm)
+
+       ! Clean up allocated arrays:
+
+  deallocate(gridWeights1, gridWeights2, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  'ERROR--deallocate(gridWeights1,...) failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine PairedSpatialIntegralRAttrGG_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialAverageRAttrGG_ - Do two spatial averages at once.
+!
+! !DESCRIPTION:
+! This routine computes spatial averages of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} arguments 
+! {\tt inAv1} and {\tt inAv2}, returning the integrals in the output 
+! {\tt AttrVect} arguments {\tt outAv1} and {\tt outAv2}, respectively .  
+! The integrals of {\tt inAv1} and {\tt inAv2} are computed using 
+! spatial weights stored in the input {\tt GeneralGrid} arguments  
+! {\tt GGrid1} and {\tt GGrid2}, respectively.  The spatial weights in 
+! in {\tt GGrid1} and {\tt GGrid2} are identified by the input {\tt CHARACTER} 
+! arguments {\tt WeightTag1} and {\tt WeightTag2}, respectively.  
+! This paired average is implicitly a 
+! distributed operation (the whole motivation for pairing the averages is 
+! to reduce communication latency costs), and the Fortran MPI communicator
+! handle is defined by the input {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the {\tt GeneralGrid} {\tt GGrid1} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the point weights stored in {\tt GGrid1}.  The same
+! relationship must apply between {\tt inAv2} and {\tt GGrid2}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialAverageRAttrGG_(inAv1, outAv1, GGrid1, WeightTag1, &
+                                         inAv2, outAv2, GGrid2, WeightTag2, &
+                                         comm)
+! ! USES:
+
+      use m_realkinds, only : FP
+   
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero 
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),    intent(IN) :: inAv1
+      type(GeneralGrid), intent(IN) :: GGrid1
+      character(len=*),  intent(IN) :: WeightTag1
+      type(AttrVect),    intent(IN) :: inAv2
+      type(GeneralGrid), intent(IN) :: GGrid2
+      character(len=*),  intent(IN) :: WeightTag2
+      integer,           intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	09May02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+! 	14Jun02 - J.W. Larson <larson@mcs.anl.gov> - Bug fix to reflect
+!                 new interface to PairedSpatialIntegralRAttrGG_().
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialAverageRAttrGG_'
+
+  type(AttrVect) :: integratedAv1, integratedAv2
+  type(List) :: nullIList
+  integer :: i, ierr, iweight1, iweight2
+
+       ! Compute the spatial integral:
+
+     call PairedSpatialIntegralRAttrGG_(inAv1, integratedAv1, GGrid1, WeightTag1, &
+	                               inAv2, integratedAv2, GGrid2,     &
+				       WeightTag2, .TRUE., comm)
+
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight1 = AttrVect_indexRA(integratedAv1, WeightTag1)
+  if(integratedAv1%rAttr(iweight1, 1) == 0._FP) then   
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in first integral is zero.'
+     call die(myname_)
+  endif
+
+  iweight2 = AttrVect_indexRA(integratedAv2, WeightTag2)
+  if(integratedAv2%rAttr(iweight2, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in second integral is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVects outAv1 and outAv2:
+
+  call List_nullify(nullIList)
+
+  call AttrVect_init(outAv1, iList=nullIList, rList=inAv1%rList, lsize=1)
+  call AttrVect_zero(outAv1)
+  call AttrVect_init(outAv2, iList=nullIList, rList=InAv2%rList, lsize=1)
+  call AttrVect_zero(outAv2)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv1)
+     outAv1%rAttr(i,1) = integratedAv1%rAttr(i,1) &
+	                               / integratedAv1%rAttr(iweight1,1) 
+  end do
+
+  do i=1,AttrVect_nRAttr(outAv2)
+     outAv2%rAttr(i,1) = integratedAv2%rAttr(i,1) &
+	                               / integratedAv2%rAttr(iweight2,1) 
+  end do
+
+       ! Clean up temporary AttrVects:
+
+  call AttrVect_clean(integratedAv1)
+  call AttrVect_clean(integratedAv2)
+
+ end subroutine PairedSpatialAverageRAttrGG_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedMaskedIntegralRAttrGG_ - Do two masked integrals at once.
+!
+! !DESCRIPTION:
+! This routine computes a pair of masked spatial integrals of the {\tt REAL} 
+! attributes of the input {\tt AttrVect} arguments {\tt inAv} and 
+! {\tt inAv2}, returning the masked integrals in the output {\tt AttrVect} 
+! {\tt outAv1} and {\tt outAv2}, respectively.  All of the spatial weighting
+! and masking data for each set of integrals are assumed stored in the input 
+! {\tt GeneralGrid} arguments {\tt GGrid} and {\tt GGrid2}.  If integer 
+! masks are to be used, their integer  attribute names in {\tt GGrid1} 
+! and {\tt GGrid2} are named as a colon-delimited lists in the optional 
+! {\tt CHARACTER} input arguments {\tt iMaskTags1} and {\tt iMaskTags2}, 
+! respectively.  Real masks (if desired) are referenced by their real 
+! attribute names in {\tt GGrid1} and {\tt GGrid2} are named as 
+! colon-delimited lists in the optional {\tt CHARACTER} input arguments 
+! {\tt rMaskTags1} and {\tt rMaskTags2}, respectively.  The user specifies 
+! a choice of mask combination method with the input {\tt LOGICAL} argument
+! {\tt UseFastMethod}.  If ${\tt UseFastMethod} = {\tt .FALSE.}$ this 
+! routine checks each mask entry to ensure that the integer masks contain
+! only ones and zeroes, and that entries in the real masks are all in
+! the closed interval $[0,1]$.  If ${\tt UseFastMethod} = {\tt .TRUE.}$,
+! this routine performs direct products of the masks, assuming that the
+! user has validated them in advance.  The optional {\tt LOGICAL} input 
+! argument {\tt SumWeights} determines whether the masked sum of the spatial
+! weights is computed and returned in {\tt outAv1} and {\tt outAv2} with the 
+! real attribute names supplied in the {\tt CHARACTER} input arguments
+! {\tt SpatialWeightTag1}, and {\tt SpatialWeightTag2}, respectively.  
+! This paired integral is implicitly a distributed operation (the whole 
+! motivation for pairing the averages is to reduce communication latency 
+! costs), and the Fortran MPI communicator handle is defined by the input 
+! {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the {\tt GeneralGrid} {\tt GGrid1} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the point weights stored in {\tt GGrid1}.  The same
+! relationship must apply between {\tt inAv2} and {\tt GGrid2}.
+!
+! {\bf N.B.:  }  If {\tt PairedMaskedIntegralRAttrGG\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}, 
+! then the value of {\tt SpatialWeightTag1} must not conflict with any of the 
+! {\tt REAL} attribute tags in {\tt inAv1} and the value of 
+! {\tt SpatialWeightTag2} must not conflict with any of the {\tt REAL} 
+! attribute tags in {\tt inAv2}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedMaskedIntegralRAttrGG_(inAv1, outAv1, GGrid1, &
+                                         SpatialWeightTag1, rMaskTags1, &
+                                         iMaskTags1, inAv2, outAv2, GGrid2, &
+                                         SpatialWeightTag2, rMaskTags2, &
+                                         iMaskTags2, UseFastMethod, &
+                                         SumWeights, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),              intent(IN) :: inAv1
+      type(GeneralGrid),           intent(IN) :: GGrid1
+      character(len=*),            intent(IN) :: SpatialWeightTag1
+      character(len=*),  optional, intent(IN) :: iMaskTags1
+      character(len=*),  optional, intent(IN) :: rMaskTags1
+      type(AttrVect),              intent(IN) :: inAv2
+      type(GeneralGrid),           intent(IN) :: GGrid2
+      character(len=*),            intent(IN) :: SpatialWeightTag2
+      character(len=*),  optional, intent(IN) :: iMaskTags2
+      character(len=*),  optional, intent(IN) :: rMaskTags2
+      logical,                     intent(IN) :: UseFastMethod
+      logical,           optional, intent(IN) :: SumWeights
+      integer,                     intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	17Jun02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+! 	19Jun02 - J.W. Larson <larson@mcs.anl.gov> - Shortened the name
+!                 for compatibility with the Portland Group f90 compiler
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_ = &
+                            myname//'::PairedMaskedIntegralRAttrGG_'
+
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: PairedBuffer, OutPairedBuffer
+  integer :: ierr, nRA1, nRA2, PairedBufferLength
+
+        ! Basic Argument Validity Checks:
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid1)) then
+     ierr = AttrVect_lsize(inAv1) - GeneralGrid_lsize(GGrid1)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+          ':: inAv1 / GGrid1 length mismatch:  ', &
+          ' AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+          ' GeneralGrid_lsize(GGrid1) = ',GeneralGrid_lsize(GGrid1)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= GeneralGrid_lsize(GGrid2)) then
+     ierr = AttrVect_lsize(inAv2) - GeneralGrid_lsize(GGrid2)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+          ':: inAv2 / GGrid2 length mismatch:  ', &
+          ' AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+          ' GeneralGrid_lsize(GGrid2) = ',GeneralGrid_lsize(GGrid2)
+     call die(myname_)
+  endif
+
+        ! Are we summing the integration weights for the input
+        ! GeneralGrids?
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+  else
+     mySumWeights = .FALSE.
+  endif
+
+        ! Begin by invoking MaskedSpatialIntegralRAttrGG_() for each
+        ! AttrVect/GeneralGrid pair.  This is done LOCALLY to create
+        ! integratedAv1 and integratedAv2, respectively.
+
+        ! Local Masked Integral #1:
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both Integer and Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv1, outAv1, GGrid1, &
+	                                  SpatialWeightTag1, iMaskTags1, &
+					  rMaskTags1, UseFastMethod,  &
+					  mySumWeights, SpatialWeightTag1)
+     else ! Integer Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv1, outAv1, GGrid1, &
+	                                  SpatialWeightTag1, &
+					  iMaskTags=iMaskTags1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag1)
+     endif ! if(present(rMaskTags1))...
+
+  else ! No Integer Masking
+
+     if(present(rMaskTags1)) then ! Real Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv1, outAv1, GGrid1, &
+	                                  SpatialWeightTag=SpatialWeightTag1, &
+					  rMaskTags=rMaskTags1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag1)
+     else ! Neither Integer nor Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv1, outAv1, GGrid1, &
+	                                  SpatialWeightTag=SpatialWeightTag1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag1)
+
+     endif ! if(present(rMaskTags1))...
+
+  endif ! if(present(iMaskTags1))...
+
+        ! Local Masked Integral #2:
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both Integer and Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv2, outAv2, GGrid2, &
+	                                  SpatialWeightTag2, iMaskTags2, &
+					  rMaskTags2, UseFastMethod,  &
+					  mySumWeights, SpatialWeightTag2)
+     else ! Integer Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv2, outAv2, GGrid2, &
+	                                  SpatialWeightTag2, &
+					  iMaskTags=iMaskTags2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag2)
+     endif ! if(present(rMaskTags2))...
+
+  else ! No Integer Masking
+
+     if(present(rMaskTags2)) then ! Real Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv2, outAv2, GGrid2, &
+	                                  SpatialWeightTag=SpatialWeightTag2, &
+					  rMaskTags=rMaskTags2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag2)
+     else ! Neither Integer nor Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv2, outAv2, GGrid2, &
+	                                  SpatialWeightTag=SpatialWeightTag2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=mySumWeights, &
+					  WeightSumTag=SpatialWeightTag2)
+
+     endif ! if(present(rMaskTags2))...
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Create the paired buffer for the Global Sum
+
+  nRA1 = AttrVect_nRAttr(outAv1)
+  nRA2 = AttrVect_nRAttr(outAv2)
+
+  PairedBufferLength =  nRA1 + nRA2
+  allocate(PairedBuffer(PairedBufferLength), OutPairedBuffer(PairedBufferLength), &
+           stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--allocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load the paired buffer
+
+  PairedBuffer(1:nRA1) = outAv1%rAttr(1:nRA1,1)
+  PairedBuffer(nRA1+1:PairedBufferLength) = outAv2%rAttr(1:nRA2,1)
+
+       ! Perform the global sum on the paired buffer
+
+  call MPI_AllReduce(PairedBuffer, OutPairedBuffer, PairedBufferLength, &
+                        MP_Type(PairedBuffer(1)), MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+  	      ':: Fatal Error--MPI_ALLREDUCE() failed with ierror = ',ierr
+     call MP_perr_die(myname_,'MPI_ALLREDUCE() failed',ierr)
+  endif
+
+       ! Unload OutPairedBuffer into outAv1 and outAv2:
+
+  outAv1%rAttr(1:nRA1,1) = OutPairedBuffer(1:nRA1)
+  outAv2%rAttr(1:nRA2,1) = OutPairedBuffer(nRA1+1:PairedBufferLength)
+
+  deallocate(PairedBuffer, OutPairedBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--deallocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine PairedMaskedIntegralRAttrGG_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedMaskedAverageRAttrGG_ - Do two masked averages at once.
+!
+! !DESCRIPTION:
+! This routine computes a pair of masked spatial averages of the {\tt REAL} 
+! attributes of the input {\tt AttrVect} arguments {\tt inAv} and 
+! {\tt inAv2}, returning the masked averagess in the output {\tt AttrVect} 
+! {\tt outAv1} and {\tt outAv2}, respectively.  All of the spatial weighting
+! and masking data for each set of averages are assumed stored in the input 
+! {\tt GeneralGrid} arguments {\tt GGrid} and {\tt GGrid2}.  If integer 
+! masks are to be used, their integer  attribute names in {\tt GGrid1} 
+! and {\tt GGrid2} are named as a colon-delimited lists in the optional 
+! {\tt CHARACTER} input arguments {\tt iMaskTags1} and {\tt iMaskTags2}, 
+! respectively.  Real masks (if desired) are referenced by their real 
+! attribute names in {\tt GGrid1} and {\tt GGrid2} are named as 
+! colon-delimited lists in the optional {\tt CHARACTER} input arguments 
+! {\tt rMaskTags1} and {\tt rMaskTags2}, respectively.  The user specifies 
+! a choice of mask combination method with the input {\tt LOGICAL} argument
+! {\tt UseFastMethod}.  If ${\tt UseFastMethod} = {\tt .FALSE.}$ this 
+! routine checks each mask entry to ensure that the integer masks contain
+! only ones and zeroes, and that entries in the real masks are all in
+! the closed interval $[0,1]$.  If ${\tt UseFastMethod} = {\tt .TRUE.}$,
+! this routine performs direct products of the masks, assuming that the
+! user has validated them in advance.  This paired average is implicitly 
+! a distributed operation (the whole motivation for pairing the averages 
+! is to reduce communication latency costs), and the Fortran MPI communicator 
+! handle is defined by the input {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the {\tt GeneralGrid} {\tt GGrid1} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the point weights stored in {\tt GGrid1}.  The same
+! relationship must apply between {\tt inAv2} and {\tt GGrid2}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedMaskedAverageRAttrGG_(inAv1, outAv1, GGrid1, &
+                                        SpatialWeightTag1, rMaskTags1, &
+                                        iMaskTags1, inAv2, outAv2, GGrid2, &
+                                        SpatialWeightTag2, rMaskTags2, &
+                                        iMaskTags2, UseFastMethod, &
+                                        comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+
+      use m_realkinds, only : FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero 
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_GeneralGrid, only : GeneralGrid
+      use m_GeneralGrid, only : GeneralGrid_lsize => lsize
+      use m_GeneralGrid, only : GeneralGrid_indexRA => indexRA
+      use m_GeneralGrid, only : GeneralGrid_exportRAttr => exportRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),              intent(IN) :: inAv1
+      type(GeneralGrid),           intent(IN) :: GGrid1
+      character(len=*),            intent(IN) :: SpatialWeightTag1
+      character(len=*),  optional, intent(IN) :: iMaskTags1
+      character(len=*),  optional, intent(IN) :: rMaskTags1
+      type(AttrVect),              intent(IN) :: inAv2
+      type(GeneralGrid),           intent(IN) :: GGrid2
+      character(len=*),            intent(IN) :: SpatialWeightTag2
+      character(len=*),  optional, intent(IN) :: iMaskTags2
+      character(len=*),  optional, intent(IN) :: rMaskTags2
+      logical,                     intent(IN) :: UseFastMethod
+      integer,                     intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	17Jun02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+! 	19Jun02 - J.W. Larson <larson@mcs.anl.gov> - Shortened the name
+!                 for compatibility with the Portland Group f90 compiler
+! 	25Jul02 - J.W. Larson E.T. Ong - Bug fix.  This routine was 
+!                 previously doing integrals rather than area averages.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_ = &
+                            myname//'::PairedMaskedAverageRAttrGG_'
+
+  type(AttrVect) :: LocalIntegral1, LocalIntegral2
+  type(List) :: nullIList
+  real(FP), dimension(:), pointer :: PairedBuffer, OutPairedBuffer
+  integer :: i, ierr, nRA1, nRA2, PairedBufferLength
+  real(FP) :: WeightSumInv
+
+        ! Basic Argument Validity Checks:
+
+  if(AttrVect_lsize(inAv1) /= GeneralGrid_lsize(GGrid1)) then
+     ierr = AttrVect_lsize(inAv1) - GeneralGrid_lsize(GGrid1)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+          ':: inAv1 / GGrid1 length mismatch:  ', &
+          ' AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+          ' GeneralGrid_lsize(GGrid1) = ',GeneralGrid_lsize(GGrid1)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= GeneralGrid_lsize(GGrid2)) then
+     ierr = AttrVect_lsize(inAv2) - GeneralGrid_lsize(GGrid2)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+          ':: inAv2 / GGrid2 length mismatch:  ', &
+          ' AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+          ' GeneralGrid_lsize(GGrid2) = ',GeneralGrid_lsize(GGrid2)
+     call die(myname_)
+  endif
+
+        ! Begin by invoking MaskedSpatialIntegralRAttrGG_() for each
+        ! AttrVect/GeneralGrid pair.  This is done LOCALLY to create
+        ! LocalIntegral1 and LocalIntegral2, respectively.
+
+        ! Local Masked Integral #1:
+
+  if(present(iMaskTags1)) then
+
+     if(present(rMaskTags1)) then ! both Integer and Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv1, LocalIntegral1, GGrid1, &
+	                                  SpatialWeightTag1, iMaskTags1, &
+					  rMaskTags1, UseFastMethod,  &
+					  .TRUE., SpatialWeightTag1)
+     else ! Integer Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv1, LocalIntegral1, GGrid1, &
+	                                  SpatialWeightTag1, &
+					  iMaskTags=iMaskTags1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag1)
+     endif ! if(present(rMaskTags1))...
+
+  else ! No Integer Masking
+
+     if(present(rMaskTags1)) then ! Real Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv1, LocalIntegral1, GGrid1, &
+	                                  SpatialWeightTag=SpatialWeightTag1, &
+					  rMaskTags=rMaskTags1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag1)
+     else ! Neither Integer nor Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv1, LocalIntegral1, GGrid1, &
+	                                  SpatialWeightTag=SpatialWeightTag1, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag1)
+
+     endif ! if(present(rMaskTags1))...
+
+  endif ! if(present(iMaskTags1))...
+
+        ! Local Masked Integral #2:
+
+  if(present(iMaskTags2)) then
+
+     if(present(rMaskTags2)) then ! both Integer and Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv2, LocalIntegral2, GGrid2, &
+	                                  SpatialWeightTag2, iMaskTags2, &
+					  rMaskTags2, UseFastMethod,  &
+					  .TRUE., SpatialWeightTag2)
+     else ! Integer Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv2, LocalIntegral2, GGrid2, &
+	                                  SpatialWeightTag2, &
+					  iMaskTags=iMaskTags2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag2)
+     endif ! if(present(rMaskTags2))...
+
+  else ! No Integer Masking
+
+     if(present(rMaskTags2)) then ! Real Masking Only
+	call MaskedSpatialIntegralRAttrGG_(inAv2, LocalIntegral2, GGrid2, &
+	                                  SpatialWeightTag=SpatialWeightTag2, &
+					  rMaskTags=rMaskTags2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag2)
+     else ! Neither Integer nor Real Masking
+	call MaskedSpatialIntegralRAttrGG_(inAv2, LocalIntegral2, GGrid2, &
+	                                  SpatialWeightTag=SpatialWeightTag2, &
+					  UseFastMethod=UseFastMethod,  &
+					  SumWeights=.TRUE., &
+					  WeightSumTag=SpatialWeightTag2)
+
+     endif ! if(present(rMaskTags2))...
+
+  endif ! if(present(iMaskTags2))...
+
+       ! Create the paired buffer for the Global Sum
+
+  nRA1 = AttrVect_nRAttr(LocalIntegral1)
+  nRA2 = AttrVect_nRAttr(LocalIntegral2)
+
+  PairedBufferLength =  nRA1 + nRA2
+  allocate(PairedBuffer(PairedBufferLength), OutPairedBuffer(PairedBufferLength), &
+           stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--allocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load the paired buffer
+
+  PairedBuffer(1:nRA1) = LocalIntegral1%rAttr(1:nRA1,1)
+  PairedBuffer(nRA1+1:PairedBufferLength) = LocalIntegral2%rAttr(1:nRA2,1)
+
+       ! Perform the global sum on the paired buffer
+
+  call MPI_AllReduce(PairedBuffer, OutPairedBuffer, PairedBufferLength, &
+                        MP_Type(PairedBuffer(1)), MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+  	      ':: Fatal Error--MPI_ALLREDUCE() failed with ierror = ',ierr
+     call MP_perr_die(myname_,'MPI_ALLREDUCE() failed',ierr)
+  endif
+
+       ! Create outAv1 and outAv2 from inAv1 and inAv2, respectively:
+
+  call List_nullify(nullIList)
+
+  call AttrVect_init(outAv1, iList=nullIList, rList=inAv1%rList, lsize=1)
+  call AttrVect_zero(outAv1)
+  call AttrVect_init(outAv2, iList=nullIList, rList=inAv2%rList, lsize=1)
+  call AttrVect_zero(outAv2)
+
+       ! Unload/rescale OutPairedBuffer into outAv1 and outAv2:
+
+  nRA1 = AttrVect_nRAttr(outAv1)
+  nRA2 = AttrVect_nRAttr(outAv2)
+
+       ! First outAv1:
+
+  if(OutPairedBuffer(nRA1+1) /= 0.) then
+     WeightSumInv = 1._FP / OutPairedBuffer(nRA1+1) ! Sum of weights on grid1
+                                                 ! is the nRA1+1th element in
+                                                 ! the paired buffer.
+  else
+     write(stderr,'(2a)') myname_, &
+	  ':: FATAL ERROR--Sum of the Weights for integral #1 is zero!  Terminating...'
+     call die(myname_)
+  endif
+
+       ! Rescale global integral to get global average:
+
+  do i=1,nRA1
+     outAv1%rAttr(i,1) = WeightSumInv * OutPairedBuffer(i)
+  end do
+
+       ! And then outAv2:
+
+  if(OutPairedBuffer(PairedBufferLength) /= 0.) then
+     WeightSumInv = 1._FP / OutPairedBuffer(PairedBufferLength) ! Sum of weights on grid2
+                                                             ! is the last element in
+                                                             ! the paired buffer.
+  else
+     write(stderr,'(2a)') myname_, &
+	  ':: FATAL ERROR--Sum of the Weights for integral #2 is zero!  Terminating...'
+     call die(myname_)
+  endif
+
+       ! Rescale global integral to get global average:
+
+  do i=1,nRA2
+     outAv2%rAttr(i,1) = WeightSumInv * OutPairedBuffer(i+nRA1+1)
+  end do
+
+       ! Clean up allocated structures
+
+  call AttrVect_clean(LocalIntegral1)
+  call AttrVect_clean(LocalIntegral2)
+
+  deallocate(PairedBuffer, OutPairedBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--deallocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine PairedMaskedAverageRAttrGG_
+
+ end module m_SpatialIntegral
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegralV.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegralV.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_SpatialIntegralV.F90	(revision 4775)
@@ -0,0 +1,2017 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_SpatialIntegralV.F90,v 1.7 2008-05-12 01:59:33 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SpatialIntegralV - Spatial Integrals and Averages using vectors of weights
+!
+! !DESCRIPTION:  This module provides spatial integration and averaging 
+! services for the MCT similar to those in {\tt m\_SpatialIntegral} except
+! the weights are provided by an input vector instead of through a
+! {\tt GeneralGrid}.  See the description for {\tt m\_SpatialIntegral} for
+! more information
+!
+!
+! Paired masked spatial integrals and averages have not yet been implemented in
+! vector form.
+!
+! !INTERFACE:
+
+ module m_SpatialIntegralV
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: SpatialIntegralV        ! Spatial Integral
+      public :: SpatialAverageV         ! Spatial Area Average
+
+      public :: MaskedSpatialIntegralV  ! Masked Spatial Integral
+      public :: MaskedSpatialAverageV   ! MaskedSpatial Area Average
+
+      public :: PairedSpatialIntegralsV ! A Pair of Spatial 
+                                      ! Integrals 
+
+      public :: PairedSpatialAveragesV  ! A Pair of Spatial 
+                                      ! Area Averages
+
+      interface SpatialIntegralV ; module procedure &
+	   SpatialIntegralRAttrVSP_, &
+	   SpatialIntegralRAttrVDP_
+      end interface
+      interface SpatialAverageV ; module procedure &
+	   SpatialAverageRAttrVSP_, &
+	   SpatialAverageRAttrVDP_
+      end interface
+      interface MaskedSpatialIntegralV ; module procedure &
+	   MaskedSpatialIntegralRAttrVSP_, &
+	   MaskedSpatialIntegralRAttrVDP_
+      end interface
+      interface MaskedSpatialAverageV ; module procedure &
+	   MaskedSpatialAverageRAttrVSP_, &
+	   MaskedSpatialAverageRAttrVDP_
+      end interface
+      interface PairedSpatialIntegralsV ; module procedure &
+	    PairedSpatialIntegralRAttrVSP_, &
+	    PairedSpatialIntegralRAttrVDP_
+      end interface
+      interface PairedSpatialAveragesV ; module procedure &
+	    PairedSpatialAverageRAttrVSP_, &
+	    PairedSpatialAverageRAttrVDP_
+      end interface
+
+! !REVISION HISTORY:
+! 	4Jan04 - R.Jacob <jacob@mcs.anl.gov> - move Vector versions of routines
+!                 from m_SpatialIntegral to this file.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_SpatialIntegralV'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialIntegralRAttrVSP_ - Compute spatial integral.
+!
+! !DESCRIPTION:
+! This routine computes spatial integrals of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} argument 
+! {\tt inAv}.  {\tt SpatialIntegralRAttrV\_()} takes the input 
+! {\tt AttrVect} argument {\tt inAv} and computes the spatial 
+! integral using weights stored in the input {\tt REAL} array argument 
+! {\tt Weights}.  The integral of each {\tt REAL} attribute is returned 
+! in the output {\tt AttrVect} argument {\tt outAv}. If 
+! {\tt SpatialIntegralRAttrV\_()} is invoked with the optional {\tt LOGICAL} 
+! input argument {\tt SumWeights} set as {\tt .TRUE.}, then the weights 
+! are also summed and stored in {\tt outAv} (and can be referenced with 
+! the attribute name {\tt WeightTag}.  If {\tt SpatialIntegralRAttrV\_()} is 
+! invoked with the optional {\tt INTEGER} argument {\tt comm} (a Fortran 
+! MPI communicator handle), the summation operations for the integral are 
+! completed on the local process, then reduced across the communicator, 
+! with all processes receiving the result.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input array {\tt Weights} must be equal.  That is, there must be 
+! a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt Weights}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}. 
+! In this case, the none of {\tt REAL} attribute tags in {\tt inAv} may be 
+! named the same as the string contained in {\tt WeightTag}, which is an 
+! attribute name reserved for the sum of the weights in the output {\tt AttrVect} 
+! {\tt outAv}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine SpatialIntegralRAttrVSP_(inAv, outAv, Weights, SumWeights, &
+                                  WeightTag, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_AttrVectReduce, only : AttrVect_GlobalWeightedSumRAttr => &
+	                                         GlobalWeightedSumRAttr
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),               intent(IN) :: inAv
+      real(SP), dimension(:),       pointer    :: Weights
+      logical,            optional, intent(IN) :: SumWeights
+      character(len=*),   optional, intent(IN) :: WeightTag
+      integer,            optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	07Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialIntegralRAttrVSP_'
+
+  integer :: ierr, length
+  logical :: mySumWeights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(Weights)) then
+     ierr = AttrVect_lsize(inAv) - size(Weights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / Weights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(Weights) = ',size(Weights)
+     call die(myname_)
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+     if(.not. present(WeightTag)) then
+	write(stderr,'(3a)') myname_,':: FATAL--If the input argument SumWeights=.TRUE.,', &
+                        ' then the argument WeightTag must be provided.'
+	call die(myname_)
+     endif
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Compute the sum
+
+  if(present(comm)) then ! compute distributed AllReduce-style sum:
+
+     if(mySumWeights) then ! return the spatial sum of the weights in outAV
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, &
+ 	                                     comm, WeightTag)
+     else
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, comm)
+     endif
+
+  else ! compute local sum:
+
+     if(mySumWeights) then ! return the spatial sum of the weights in outAV
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights, &
+                                            WeightTag)
+     else
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights)
+     endif
+
+  endif ! if(present(comm))...
+
+ end subroutine SpatialIntegralRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialIntegralRAttrVDP_ - Compute spatial integral.
+!
+! !DESCRIPTION:
+! Double precision version of SpatialIntegralRAttrVSP_
+!
+! !INTERFACE:
+
+ subroutine SpatialIntegralRAttrVDP_(inAv, outAv, Weights, SumWeights, &
+                                  WeightTag, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_AttrVectReduce, only : AttrVect_GlobalWeightedSumRAttr => &
+	                                         GlobalWeightedSumRAttr
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),               intent(IN) :: inAv
+      real(DP), dimension(:),       pointer    :: Weights
+      logical,            optional, intent(IN) :: SumWeights
+      character(len=*),   optional, intent(IN) :: WeightTag
+      integer,            optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	07Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialIntegralRAttrVDP_'
+
+  integer :: ierr, length
+  logical :: mySumWeights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(Weights)) then
+     ierr = AttrVect_lsize(inAv) - size(Weights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / Weights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(Weights) = ',size(Weights)
+     call die(myname_)
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+     if(.not. present(WeightTag)) then
+	write(stderr,'(3a)') myname_,':: FATAL--If the input argument SumWeights=.TRUE.,', &
+                        ' then the argument WeightTag must be provided.'
+	call die(myname_)
+     endif
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Compute the sum
+
+  if(present(comm)) then ! compute distributed AllReduce-style sum:
+
+     if(mySumWeights) then ! return the spatial sum of the weights in outAV
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, &
+ 	                                     comm, WeightTag)
+     else
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, comm)
+     endif
+
+  else ! compute local sum:
+
+     if(mySumWeights) then ! return the spatial sum of the weights in outAV
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights, &
+                                            WeightTag)
+     else
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights)
+     endif
+
+  endif ! if(present(comm))...
+
+ end subroutine SpatialIntegralRAttrVDP_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialAverageRAttrVSP_ - Compute spatial average.
+!
+! !DESCRIPTION:
+! This routine computes spatial averages of the {\tt REAL} attributes
+! of the input {\tt AttrVect} argument {\tt inAv}.  
+! {\tt SpatialAverageRAttrV\_()} takes the input {\tt AttrVect} argument 
+! {\tt inAv} and computes the spatial average using weights 
+! stored in the {\tt REAL} array {\tt Weights}.  The average of each 
+! {\tt REAL} attribute is returned in the output {\tt AttrVect} argument 
+! {\tt outAv}.  If {\tt SpatialAverageRAttrV\_()} is invoked with the 
+! optional {\tt INTEGER} argument {\tt comm} (a Fortran MPI communicator 
+! handle), the summation operations for the average are completed on the 
+! local process, then reduced across the communicator, with all processes 
+! receiving the result.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input array {\tt Weights} must be equal.  That is, there must 
+! be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt Weights}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine SpatialAverageRAttrVSP_(inAv, outAv, Weights, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN)  :: inAv
+      real(SP), dimension(:), pointer :: Weights
+      integer, optional,  intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),     intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialAverageRAtttrVSP_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+  integer :: i, ierr, iweight
+
+       ! Compute the spatial integral:
+
+  if(present(comm)) then
+     call SpatialIntegralV(inAv, integratedAv, Weights, &
+	                         .TRUE., 'weights', comm)
+  else
+     call SpatialIntegralV(inAv, integratedAv, Weights, .TRUE., 'weights')
+  endif
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, 'weights')
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine SpatialAverageRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: SpatialAverageRAttrVDP_ - Compute spatial average.
+!
+! !DESCRIPTION:
+! Double pecision version of SpatialAverageRAttrVSP
+!
+! !INTERFACE:
+
+ subroutine SpatialAverageRAttrVDP_(inAv, outAv, Weights, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN)  :: inAv
+      real(DP), dimension(:), pointer :: Weights
+      integer, optional,  intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),     intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::SpatialAverageRAtttrVDP_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+  integer :: i, ierr, iweight
+
+       ! Compute the spatial integral:
+
+  if(present(comm)) then
+     call SpatialIntegralV(inAv, integratedAv, Weights, &
+	                         .TRUE., 'weights', comm)
+  else
+     call SpatialIntegralV(inAv, integratedAv, Weights, .TRUE., 'weights')
+  endif
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, 'weights')
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine SpatialAverageRAttrVDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialIntegralRAttrVSP_ - Masked spatial integral.
+!
+! !DESCRIPTION: 
+! This routine computes masked spatial integrals of the {\tt REAL} 
+! attributes of the input {\tt AttrVect} argument {\tt inAv}, returning 
+! the masked integrals in the output {\tt AttrVect} argument {\tt outAv}.  
+! The masked integral is computed using weights stored in the input 
+! {\tt REAL} array argument {\tt SpatialWeights}.  Integer masking (if 
+! desired) is provided in the optional input {\tt INTEGER} array {\tt iMask},
+! and real masking (if desired) is provided in the optional input {\tt REAL} 
+! array {\tt rMask}.  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}, 
+! then the weights are also summed and stored in {\tt outAv} (and can be 
+! referenced with the attribute name defined by the optional input 
+! {\tt CHARACTER} argument {\tt WeightSumTag}.  If 
+! {\tt SpatialIntegralRAttrV\_()} is invoked with the optional {\tt INTEGER} 
+! argument {\tt comm} (a Fortran MPI communicator handle), the summation 
+! operations for the integral are completed on the local process, then 
+! reduced across the communicator, with all processes receiving the result.  
+! Otherwise, the integral is assumed to be local (or equivalent to a global 
+! address space).
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input array {\tt Weights} must be equal.  That is, there must be 
+! a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt SpatialWeights}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}. 
+! In this case, the none of {\tt REAL} attribute tags in {\tt inAv} may be 
+! named the same as the string contained in {\tt WeightSumTag}, which is an 
+! attribute name reserved for the sum of the weights in the output {\tt AttrVect} 
+! {\tt outAv}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialIntegralRAttrVSP_(inAv, outAv, SpatialWeights, iMask, &
+                                        rMask, UseFastMethod, SumWeights, &
+                                        WeightSumTag, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_AttrVectReduce, only : AttrVect_GlobalWeightedSumRAttr => &
+	                                         GlobalWeightedSumRAttr
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      real(SP),dimension(:),           pointer    :: SpatialWeights
+      integer, dimension(:), optional, pointer    :: iMask
+      real(SP),dimension(:), optional, pointer    :: rMask
+      logical,                         intent(IN) :: UseFastMethod
+      logical,               optional, intent(IN) :: SumWeights
+      character(len=*),      optional, intent(IN) :: WeightSumTag
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialIntegralRAttrVSP_'
+
+  integer :: i, ierr, length
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: Weights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(SpatialWeights)) then
+     ierr = AttrVect_lsize(inAv) - size(SpatialWeights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / SpatialWeights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(SpatialWeights) = ',size(SpatialWeights)
+     call die(myname_)
+  endif
+
+  if(present(iMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(iMask)) then
+	ierr = AttrVect_lsize(inAv) - size(iMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / iMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(iMask) = ',size(iMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(rMask)) then
+	ierr = AttrVect_lsize(inAv) - size(rMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / rMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(rMask) = ',size(rMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+     if(.not. present(WeightSumTag)) then
+	write(stderr,'(3a)') myname_,':: FATAL--If the input argument SumWeights=.TRUE.,', &
+                        ' then the argument WeightSumTag must be provided.'
+	call die(myname_)
+     endif
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Create a common Weights(:) array...
+
+  length = AttrVect_lsize(inAv)
+
+  allocate(Weights(length), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_,':: allocate(Weights(...) failed,', &
+	  ' ierr=',ierr
+     call die(myname_)
+  endif
+
+       ! Combine weights and masks into a common Weights(:) array...
+
+  if(UseFastMethod) then ! form the product of iMask, rMask, and SpatialWeights
+
+     if(present(rMask)) then ! use it to form Weights(:)
+	if(present(iMask)) then ! use it and rMask to form Weights(:)
+	   do i=1,length
+	      Weights(i) = rMask(i) * SpatialWeights(i) * iMask(i)
+	   end do
+	else
+	   do i=1,length
+	      Weights(i) = rMask(i) * SpatialWeights(i)
+	   end do
+	endif ! if(present(iMask))...
+     else
+	if(present(iMask)) then
+	   do i=1,length
+	      Weights(i) = SpatialWeights(i) * iMask(i)
+	   end do
+	else
+	   do i=1,length
+	      Weights(i) = SpatialWeights(i)
+	   end do	   
+	endif ! if(present(iMask))...
+     endif ! if(present(rMask))...
+
+
+  else ! Scan iMask and rMask carefully and set Weights(i) to zero
+       ! when iMask(i) or rMask(i) is zero.  This avoids round-off
+       ! effects from products and promotion of integers to reals.
+
+     if(present(rMask)) then ! use it to form Weights(:)
+	if(present(iMask)) then ! use it and rMask to form Weights(:)
+	   do i=1,length
+	      select case(iMask(i))
+	      case(0)
+		 Weights(i) = 0._FP
+	      case(1)
+		 if(rMask(i) == 1._FP) then
+		    Weights(i) = SpatialWeights(i)
+		 elseif(rMask(i) == 0._FP) then
+		    Weights(i) = 0._FP
+		 elseif((rMask(i) > 0._FP) .and. (rMask(i) < 1._FP)) then
+		    Weights(i) = rMask(i) * SpatialWeights(i)
+		 else ! rMask(i) < 0. or rMask(i) > 1.
+		    write(stderr,'(3a,i8,a,f10.7)') myname_, &
+			 ':: invalid value for real', &
+			 'mask entry rMask(',i,') = ',rMask(i)
+		    call die(myname_)
+                 endif
+	      case default
+		 write(stderr,'(3a,i8,a,i8)') myname_, &
+		      ':: invalid value for integer', &
+		      'mask entry iMask(',i,') = ',iMask(i)
+		 call die(myname_)
+	      end select
+	   end do
+	else
+	   do i=1,length
+	      if(rMask(i) == 1._FP) then
+		 Weights(i) = SpatialWeights(i)
+	      elseif(rMask(i) == 0._FP) then
+		 Weights(i) = 0._FP
+	      elseif((rMask(i) > 0._FP) .and. (rMask(i) < 1._FP)) then
+		 Weights(i) = rMask(i) * SpatialWeights(i)
+	      else ! rMask(i) < 0. or rMask(i) > 1.
+		 write(stderr,'(3a,i8,a,e10.6)') myname_, &
+		      ':: invalid value for real', &
+		      'mask entry rMask(',i,') = ',rMask(i)
+		 call die(myname_)
+	      endif
+	   end do
+	endif ! if(present(iMask))...
+     else ! no rMask present...
+	if(present(iMask)) then ! check iMask entries...
+	   do i=1,length
+	      select case(iMask(i))
+	      case(0)
+		 Weights(i) = 0._FP
+	      case(1)
+		 Weights(i) = SpatialWeights(i)
+	      case default
+		 write(stderr,'(3a,i8,a,i8)') myname_, &
+		      ':: invalid value for integer', &
+		      'mask entry iMask(',i,') = ',iMask(i)
+		 call die(myname_)		 
+	      end select
+	   end do
+	else ! straight assignment of SpatialWeights(:) 
+	   do i=1,length
+		 Weights(i) = SpatialWeights(i)
+	   end do	   
+	endif ! if(present(iMask))...
+     endif ! if(present(rMask))...
+
+
+  endif ! if(UseFastMethod)
+
+       ! Now that the weights are combined into a common Weights(:),
+       ! compute the masked weighted sum:
+
+  if(present(comm)) then ! compute distributed AllReduce-style sum:
+	
+     if(mySumWeights) then ! return the global sum of the weights in outAV
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, &
+   	                                     comm, WeightSumTag)
+     else
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, comm)
+     endif
+
+  else ! compute local sum:
+
+     if(mySumWeights) then ! return the global sum of the weights in outAV
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights, &
+	                                    WeightSumAttr=WeightSumTag)
+     else
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights)
+     endif
+
+  endif ! if(present(comm))...
+
+       ! Clean up the allocated Weights(:) array
+
+  deallocate(Weights, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_,':: deallocate(Weights(...) failed,', &
+	  ' ierr=',ierr
+     call die(myname_)
+  endif
+
+ end subroutine MaskedSpatialIntegralRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialIntegralRAttrVDP_ - Masked spatial integral.
+!
+! !DESCRIPTION: 
+! Double precision version of MaskedSpatialIntegralRAttrVSP_
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialIntegralRAttrVDP_(inAv, outAv, SpatialWeights, iMask, &
+                                        rMask, UseFastMethod, SumWeights, &
+                                        WeightSumTag, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+
+      use m_AttrVectReduce, only : AttrVect_GlobalWeightedSumRAttr => &
+	                                         GlobalWeightedSumRAttr
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      real(DP),dimension(:),           pointer    :: SpatialWeights
+      integer, dimension(:), optional, pointer    :: iMask
+      real(DP),dimension(:), optional, pointer    :: rMask
+      logical,                         intent(IN) :: UseFastMethod
+      logical,               optional, intent(IN) :: SumWeights
+      character(len=*),      optional, intent(IN) :: WeightSumTag
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialIntegralRAttrVDP_'
+
+  integer :: i, ierr, length
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: Weights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(SpatialWeights)) then
+     ierr = AttrVect_lsize(inAv) - size(SpatialWeights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / SpatialWeights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(SpatialWeights) = ',size(SpatialWeights)
+     call die(myname_)
+  endif
+
+  if(present(iMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(iMask)) then
+	ierr = AttrVect_lsize(inAv) - size(iMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / iMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(iMask) = ',size(iMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(rMask)) then
+	ierr = AttrVect_lsize(inAv) - size(rMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / rMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(rMask) = ',size(rMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+     if(.not. present(WeightSumTag)) then
+	write(stderr,'(3a)') myname_,':: FATAL--If the input argument SumWeights=.TRUE.,', &
+                        ' then the argument WeightSumTag must be provided.'
+	call die(myname_)
+     endif
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Create a common Weights(:) array...
+
+  length = AttrVect_lsize(inAv)
+
+  allocate(Weights(length), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_,':: allocate(Weights(...) failed,', &
+	  ' ierr=',ierr
+     call die(myname_)
+  endif
+
+       ! Combine weights and masks into a common Weights(:) array...
+
+  if(UseFastMethod) then ! form the product of iMask, rMask, and SpatialWeights
+
+     if(present(rMask)) then ! use it to form Weights(:)
+	if(present(iMask)) then ! use it and rMask to form Weights(:)
+	   do i=1,length
+	      Weights(i) = rMask(i) * SpatialWeights(i) * iMask(i)
+	   end do
+	else
+	   do i=1,length
+	      Weights(i) = rMask(i) * SpatialWeights(i)
+	   end do
+	endif ! if(present(iMask))...
+     else
+	if(present(iMask)) then
+	   do i=1,length
+	      Weights(i) = SpatialWeights(i) * iMask(i)
+	   end do
+	else
+	   do i=1,length
+	      Weights(i) = SpatialWeights(i)
+	   end do	   
+	endif ! if(present(iMask))...
+     endif ! if(present(rMask))...
+
+
+  else ! Scan iMask and rMask carefully and set Weights(i) to zero
+       ! when iMask(i) or rMask(i) is zero.  This avoids round-off
+       ! effects from products and promotion of integers to reals.
+
+     if(present(rMask)) then ! use it to form Weights(:)
+	if(present(iMask)) then ! use it and rMask to form Weights(:)
+	   do i=1,length
+	      select case(iMask(i))
+	      case(0)
+		 Weights(i) = 0._FP
+	      case(1)
+		 if(rMask(i) == 1._FP) then
+		    Weights(i) = SpatialWeights(i)
+		 elseif(rMask(i) == 0._FP) then
+		    Weights(i) = 0._FP
+		 elseif((rMask(i) > 0._FP) .and. (rMask(i) < 1._FP)) then
+		    Weights(i) = rMask(i) * SpatialWeights(i)
+		 else ! rMask(i) < 0. or rMask(i) > 1.
+		    write(stderr,'(3a,i8,a,f10.7)') myname_, &
+			 ':: invalid value for real', &
+			 'mask entry rMask(',i,') = ',rMask(i)
+		    call die(myname_)
+                 endif
+	      case default
+		 write(stderr,'(3a,i8,a,i8)') myname_, &
+		      ':: invalid value for integer', &
+		      'mask entry iMask(',i,') = ',iMask(i)
+		 call die(myname_)
+	      end select
+	   end do
+	else
+	   do i=1,length
+	      if(rMask(i) == 1._FP) then
+		 Weights(i) = SpatialWeights(i)
+	      elseif(rMask(i) == 0._FP) then
+		 Weights(i) = 0._FP
+	      elseif((rMask(i) > 0._FP) .and. (rMask(i) < 1._FP)) then
+		 Weights(i) = rMask(i) * SpatialWeights(i)
+	      else ! rMask(i) < 0. or rMask(i) > 1.
+		 write(stderr,'(3a,i8,a,e10.6)') myname_, &
+		      ':: invalid value for real', &
+		      'mask entry rMask(',i,') = ',rMask(i)
+		 call die(myname_)
+	      endif
+	   end do
+	endif ! if(present(iMask))...
+     else ! no rMask present...
+	if(present(iMask)) then ! check iMask entries...
+	   do i=1,length
+	      select case(iMask(i))
+	      case(0)
+		 Weights(i) = 0._FP
+	      case(1)
+		 Weights(i) = SpatialWeights(i)
+	      case default
+		 write(stderr,'(3a,i8,a,i8)') myname_, &
+		      ':: invalid value for integer', &
+		      'mask entry iMask(',i,') = ',iMask(i)
+		 call die(myname_)		 
+	      end select
+	   end do
+	else ! straight assignment of SpatialWeights(:) 
+	   do i=1,length
+		 Weights(i) = SpatialWeights(i)
+	   end do	   
+	endif ! if(present(iMask))...
+     endif ! if(present(rMask))...
+
+
+  endif ! if(UseFastMethod)
+
+       ! Now that the weights are combined into a common Weights(:),
+       ! compute the masked weighted sum:
+
+  if(present(comm)) then ! compute distributed AllReduce-style sum:
+	
+     if(mySumWeights) then ! return the global sum of the weights in outAV
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, &
+   	                                     comm, WeightSumTag)
+     else
+	call AttrVect_GlobalWeightedSumRAttr(inAV, outAV, Weights, comm)
+     endif
+
+  else ! compute local sum:
+
+     if(mySumWeights) then ! return the global sum of the weights in outAV
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights, &
+	                                    WeightSumAttr=WeightSumTag)
+     else
+	call AttrVect_LocalWeightedSumRAttr(inAV, outAV, Weights)
+     endif
+
+  endif ! if(present(comm))...
+
+       ! Clean up the allocated Weights(:) array
+
+  deallocate(Weights, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(3a,i8)') myname_,':: deallocate(Weights(...) failed,', &
+	  ' ierr=',ierr
+     call die(myname_)
+  endif
+
+ end subroutine MaskedSpatialIntegralRAttrVDP_
+
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialAverageRAttrVSP_ - Masked spatial average.
+!
+! !DESCRIPTION: [NEEDS **LOTS** of work...]
+! This routine computes spatial integrals of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} argument 
+! {\tt inAv}.  {\tt SpatialIntegralRAttrV\_()} takes the input 
+! {\tt AttrVect} argument {\tt inAv} and computes the spatial 
+! integral using weights stored in the input {\tt REAL} array argument 
+! {\tt Weights}.  The integral of each {\tt REAL} attribute is returned 
+! in the output {\tt AttrVect} argument {\tt outAv}. If 
+! {\tt SpatialIntegralRAttrV\_()} is invoked with the optional {\tt LOGICAL} 
+! input argument {\tt SumWeights} set as {\tt .TRUE.}, then the weights 
+! are also summed and stored in {\tt outAv} (and can be referenced with 
+! the attribute name {\tt WeightTag}.  If {\tt SpatialIntegralRAttrV\_()} is 
+! invoked with the optional {\tt INTEGER} argument {\tt comm} (a Fortran 
+! MPI communicator handle), the summation operations for the integral are 
+! completed on the local process, then reduced across the communicator, 
+! with all processes receiving the result.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv} 
+! and the input array {\tt Weights} must be equal.  That is, there must be 
+! a one-to-one correspondence between the field point values stored 
+! in {\tt inAv} and the point weights stored in {\tt Weights}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}. 
+! In this case, the none of {\tt REAL} attribute tags in {\tt inAv} may be 
+! named the same as the string contained in {\tt WeightTag}, which is an 
+! attribute name reserved for the sum of the weights in the output {\tt AttrVect} 
+! {\tt outAv}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} argument {\tt outAv} is an 
+! allocated data structure.  The user must deallocate it using the routine 
+! {\tt AttrVect\_clean()} when it is no longer needed.  Failure to do so 
+! will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialAverageRAttrVSP_(inAv, outAv, SpatialWeights, iMask, &
+                                       rMask, UseFastMethod, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      real(SP),  dimension(:),         pointer    :: SpatialWeights
+      integer, dimension(:), optional, pointer    :: iMask
+      real(SP),dimension(:), optional, pointer    :: rMask
+      logical,                         intent(IN) :: UseFastMethod
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	11Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialAverageRAttrVSP_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+
+  integer :: i, ierr, length, iweight
+  logical :: mySumWeights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(SpatialWeights)) then
+     ierr = AttrVect_lsize(inAv) - size(SpatialWeights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / SpatialWeights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(SpatialWeights) = ',size(SpatialWeights)
+     call die(myname_)
+  endif
+
+  if(present(iMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(iMask)) then
+	ierr = AttrVect_lsize(inAv) - size(iMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / iMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(iMask) = ',size(iMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(rMask)) then
+	ierr = AttrVect_lsize(inAv) - size(rMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / rMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(rMask) = ',size(rMask)
+	call die(myname_)
+     endif
+  endif
+
+       ! Compute the masked weighted sum, including the sum of the 
+       ! masked weights.
+
+  if(present(comm)) then ! communicator handle present
+
+     if(present(iMask)) then
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask, rMask, UseFastMethod, .TRUE., &
+					    'MaskedWeightsSum', comm)
+	else ! no rMask
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask=iMask, UseFastMethod=UseFastMethod, &
+                                            SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	endif ! if(present(rMask))...
+
+     else ! no iMask present...
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            rMask=rMask, UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	else ! neither rMask nor iMask present:
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	endif ! if(present(rMask))...
+
+     endif ! if(present(iMask))...
+
+  else ! no communicator handle present
+
+     if(present(iMask)) then
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask, rMask, UseFastMethod, .TRUE., &
+					    'MaskedWeightsSum')
+	else ! no rMask
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask=iMask, UseFastMethod=UseFastMethod, &
+                                            SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	endif ! if(present(rMask))...
+
+     else ! no iMask present...
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            rMask=rMask, UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	else ! neither rMask nor iMask present:
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	endif ! if(present(rMask))...
+
+     endif ! if(present(iMask))...
+
+  endif ! if(present(comm))...
+
+       ! At this point, integratedAv containes the masked spatial integrals
+       ! of the REAL attributes of inAv, along with the sum of the weights.
+       ! to compute the masked spatial average
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, 'MaskedWeightsSum')
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine MaskedSpatialAverageRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: MaskedSpatialAverageRAttrVDP_ - Masked spatial average.
+!
+! !DESCRIPTION: [NEEDS **LOTS** of work...]
+! Double precision interface version of MaskedSpatialAverageRAttrVSP_.
+!
+! !INTERFACE:
+
+ subroutine MaskedSpatialAverageRAttrVDP_(inAv, outAv, SpatialWeights, iMask, &
+                                       rMask, UseFastMethod, comm)
+
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),                  intent(IN) :: inAv
+      real(DP),  dimension(:),         pointer    :: SpatialWeights
+      integer, dimension(:), optional, pointer    :: iMask
+      real(DP),dimension(:), optional, pointer    :: rMask
+      logical,                         intent(IN) :: UseFastMethod
+      integer,               optional, intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),                  intent(OUT) :: outAv
+
+! !REVISION HISTORY:
+! 	11Jun02 - J.W. Larson <larson@mcs.anl.gov> - initial version
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MaskedSpatialAverageRAttrVDP_'
+
+  type(AttrVect) :: integratedAv
+  type(List) :: nullIList
+
+  integer :: i, ierr, length, iweight
+  logical :: mySumWeights
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv) /= size(SpatialWeights)) then
+     ierr = AttrVect_lsize(inAv) - size(SpatialWeights)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv / SpatialWeights array length mismatch:  ', &
+	  ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	  ' size(SpatialWeights) = ',size(SpatialWeights)
+     call die(myname_)
+  endif
+
+  if(present(iMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(iMask)) then
+	ierr = AttrVect_lsize(inAv) - size(iMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / iMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(iMask) = ',size(iMask)
+	call die(myname_)
+     endif
+  endif
+
+  if(present(rMask)) then ! make sure it is the right length
+     if(AttrVect_lsize(inAv) /= size(rMask)) then
+	ierr = AttrVect_lsize(inAv) - size(rMask)
+	write(stderr,'(3a,i8,a,i8)') myname_, &
+	     ':: inAv / rMask array length mismatch:  ', &
+	     ' AttrVect_lsize(inAv) = ',AttrVect_lsize(inAv), &
+	     ' size(rMask) = ',size(rMask)
+	call die(myname_)
+     endif
+  endif
+
+       ! Compute the masked weighted sum, including the sum of the 
+       ! masked weights.
+
+  if(present(comm)) then ! communicator handle present
+
+     if(present(iMask)) then
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask, rMask, UseFastMethod, .TRUE., &
+					    'MaskedWeightsSum', comm)
+	else ! no rMask
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask=iMask, UseFastMethod=UseFastMethod, &
+                                            SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	endif ! if(present(rMask))...
+
+     else ! no iMask present...
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            rMask=rMask, UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	else ! neither rMask nor iMask present:
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum', &
+					    comm=comm)
+	endif ! if(present(rMask))...
+
+     endif ! if(present(iMask))...
+
+  else ! no communicator handle present
+
+     if(present(iMask)) then
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask, rMask, UseFastMethod, .TRUE., &
+					    'MaskedWeightsSum')
+	else ! no rMask
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            iMask=iMask, UseFastMethod=UseFastMethod, &
+                                            SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	endif ! if(present(rMask))...
+
+     else ! no iMask present...
+
+	if(present(rMask)) then
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            rMask=rMask, UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	else ! neither rMask nor iMask present:
+	   call MaskedSpatialIntegralV(inAv, integratedAv, SpatialWeights,  &
+		                            UseFastMethod=UseFastMethod, &
+					    SumWeights=.TRUE., &
+					    WeightSumTag='MaskedWeightsSum')
+	endif ! if(present(rMask))...
+
+     endif ! if(present(iMask))...
+
+  endif ! if(present(comm))...
+
+       ! At this point, integratedAv containes the masked spatial integrals
+       ! of the REAL attributes of inAv, along with the sum of the weights.
+       ! to compute the masked spatial average
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight = AttrVect_indexRA(integratedAv, 'MaskedWeightsSum')
+  if(integratedAv%rAttr(iweight, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVect outAv:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv, iList=nullIList, rList=inAv%rList, lsize=1)
+  call AttrVect_zero(outAv)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv)
+     outAv%rAttr(i,1) = integratedAv%rAttr(i,1) &
+	                               / integratedAv%rAttr(iweight,1) 
+  end do
+
+       ! Clean up temporary AttrVect:
+
+  call AttrVect_clean(integratedAv)
+
+ end subroutine MaskedSpatialAverageRAttrVDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialIntegralRAttrVSP_ - Do two spatial integrals at once.
+!
+! !DESCRIPTION: 
+! This routine computes spatial integrals of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} arguments 
+! {\tt inAv1} and {\tt inAv2}, returning the integrals in the output 
+! {\tt AttrVect} arguments {\tt outAv1} and {\tt outAv2}, respectively .  
+! The integrals of {\tt inAv1} and {\tt inAv2} are computed using 
+! spatial weights stored in the input {\tt REAL} array arguments  
+! {\tt Weights1} and {\tt Weights2}, respectively.  
+! If {\tt SpatialIntegralRAttrV\_()} is invoked with the optional 
+! {\tt LOGICAL} input argument 
+! {\tt SumWeights} set as {\tt .TRUE.}, then the weights are also summed 
+! and stored in {\tt outAv1} and {\tt outAv2}, and can be referenced with 
+! the attribute tags defined by the arguments {\tt WeightName1} and 
+! {\tt WeightName2}, respectively.  This paired integral is implicitly a 
+! distributed operation (the whole motivation for pairing the integrals is 
+! to reduce communication latency costs), and the Fortran MPI communicator
+! handle is defined by the input {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the input {\tt REAL} array {\tt Weights1} must be equal.  That is, there 
+! must be a one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the point weights stored in {\tt Weights}.  The same
+! relationship must apply between {\tt inAv2} and {\tt Weights2}.
+!
+! {\bf N.B.:  }  If {\tt SpatialIntegralRAttrV\_()} is invoked with the 
+! optional {\tt LOGICAL} input argument {\tt SumWeights} set as {\tt .TRUE.}, 
+! then the value of {\tt WeightName1} must not conflict with any of the 
+! {\tt REAL} attribute tags in {\tt inAv1} and the value of {\tt WeightName2} 
+! must not conflict with any of the {\tt REAL} attribute tags in {\tt inAv2}.
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialIntegralRAttrVSP_(inAv1, outAv1, Weights1, WeightName1, &
+                                        inAv2, outAv2, Weights2, WeightName2, &
+                                        SumWeights, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN)  :: inAv1
+      real(SP),dimension(:),pointer   :: Weights1
+      character(len=*),   intent(IN)  :: WeightName1
+      type(AttrVect),     intent(IN)  :: inAv2
+      real(SP),dimension(:),pointer   :: Weights2
+      character(len=*),   intent(IN)  :: WeightName2
+      logical, optional,  intent(IN)  :: SumWeights
+      integer,            intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),     intent(OUT) :: outAv1
+      type(AttrVect),     intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialIntegralRAttrVSP_'
+
+       ! Argument Sanity Checks:
+
+  integer :: ierr, length1, length2, PairedBufferLength
+  integer :: nRA1, nRA2
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: PairedBuffer, OutPairedBuffer
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv1) /= size(Weights1)) then
+     ierr = AttrVect_lsize(inAv1) - size(Weights1)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv1 / Weights1 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  ' size(Weights1) = ',size(Weights1)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= size(Weights2)) then
+     ierr = AttrVect_lsize(inAv2) - size(Weights2)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv2 / Weights2 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  ' size(Weights2) = ',size(Weights2)
+     call die(myname_)
+  endif
+
+        ! Are we summing the integration weights?
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Compute the local contributions to the two integrals:
+
+  if(mySumWeights) then
+     call AttrVect_LocalWeightedSumRAttr(inAv1, outAv1, Weights1, WeightName1)
+     call AttrVect_LocalWeightedSumRAttr(inAv2, outAv2, Weights2, WeightName2)
+  else
+     call AttrVect_LocalWeightedSumRAttr(inAv1, outAv1, Weights1)
+     call AttrVect_LocalWeightedSumRAttr(inAv2, outAv2, Weights2)
+  endif
+
+       ! Create the paired buffer for the Global Sum
+
+  nRA1 = AttrVect_nRAttr(outAv1)
+  nRA2 = AttrVect_nRAttr(outAv2)
+
+  PairedBufferLength =  nRA1 + nRA2
+  allocate(PairedBuffer(PairedBufferLength), OutPairedBuffer(PairedBufferLength), &
+           stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--allocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load the paired buffer
+
+  PairedBuffer(1:nRA1) = outAv1%rAttr(1:nRA1,1)
+  PairedBuffer(nRA1+1:PairedBufferLength) = outAv2%rAttr(1:nRA2,1)
+
+       ! Perform the global sum on the paired buffer
+
+  call MPI_AllReduce(PairedBuffer, OutPairedBuffer, PairedBufferLength, &
+                        MP_Type(PairedBuffer(1)), MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+  	      ':: Fatal Error--MPI_ALLREDUCE() failed with ierror = ',ierr
+     call MP_perr_die(myname_,'MPI_ALLREDUCE() failed',ierr)
+  endif
+
+       ! Unload OutPairedBuffer into outAv1 and outAv2:
+
+  outAv1%rAttr(1:nRA1,1) = OutPairedBuffer(1:nRA1)
+  outAv2%rAttr(1:nRA2,1) = OutPairedBuffer(nRA1+1:PairedBufferLength)
+
+       ! Clean up allocated arrays:
+
+  deallocate(PairedBuffer, OutPairedBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  'ERROR--deallocate(PairedBuffer,...) failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine PairedSpatialIntegralRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! -------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialIntegralRAttrVDP_ - Two spatial integrals.
+!
+! !DESCRIPTION: 
+! Double precision interface version of PairedSpatialIntegralRAttrVSP_.
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialIntegralRAttrVDP_(inAv1, outAv1, Weights1, WeightName1, &
+                                        inAv2, outAv2, Weights2, WeightName2, &
+                                        SumWeights, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN)  :: inAv1
+      real(DP),dimension(:),pointer   :: Weights1
+      character(len=*),   intent(IN)  :: WeightName1
+      type(AttrVect),     intent(IN)  :: inAv2
+      real(DP),dimension(:),pointer   :: Weights2
+      character(len=*),   intent(IN)  :: WeightName2
+      logical, optional,  intent(IN)  :: SumWeights
+      integer,            intent(IN)  :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),     intent(OUT) :: outAv1
+      type(AttrVect),     intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	10Jun02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!
+! ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialIntegralRAttrVDP_'
+
+       ! Argument Sanity Checks:
+
+  integer :: ierr, length1, length2, PairedBufferLength
+  integer :: nRA1, nRA2
+  logical :: mySumWeights
+  real(FP), dimension(:), pointer :: PairedBuffer, OutPairedBuffer
+
+       ! Argument Validity Checks
+
+  if(AttrVect_lsize(inAv1) /= size(Weights1)) then
+     ierr = AttrVect_lsize(inAv1) - size(Weights1)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv1 / Weights1 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv1) = ',AttrVect_lsize(inAv1), &
+	  ' size(Weights1) = ',size(Weights1)
+     call die(myname_)
+  endif
+
+  if(AttrVect_lsize(inAv2) /= size(Weights2)) then
+     ierr = AttrVect_lsize(inAv2) - size(Weights2)
+     write(stderr,'(3a,i8,a,i8)') myname_, &
+	  ':: inAv2 / Weights2 length mismatch:  ', &
+	  ' AttrVect_lsize(inAv2) = ',AttrVect_lsize(inAv2), &
+	  ' size(Weights2) = ',size(Weights2)
+     call die(myname_)
+  endif
+
+        ! Are we summing the integration weights?
+
+  if(present(SumWeights)) then
+     mySumWeights = SumWeights
+  else
+     mySumWeights = .FALSE.
+  endif
+
+       ! Compute the local contributions to the two integrals:
+
+  if(mySumWeights) then
+     call AttrVect_LocalWeightedSumRAttr(inAv1, outAv1, Weights1, WeightName1)
+     call AttrVect_LocalWeightedSumRAttr(inAv2, outAv2, Weights2, WeightName2)
+  else
+     call AttrVect_LocalWeightedSumRAttr(inAv1, outAv1, Weights1)
+     call AttrVect_LocalWeightedSumRAttr(inAv2, outAv2, Weights2)
+  endif
+
+       ! Create the paired buffer for the Global Sum
+
+  nRA1 = AttrVect_nRAttr(outAv1)
+  nRA2 = AttrVect_nRAttr(outAv2)
+
+  PairedBufferLength =  nRA1 + nRA2
+  allocate(PairedBuffer(PairedBufferLength), OutPairedBuffer(PairedBufferLength), &
+           stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Fatal error--allocate(PairedBuffer...failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load the paired buffer
+
+  PairedBuffer(1:nRA1) = outAv1%rAttr(1:nRA1,1)
+  PairedBuffer(nRA1+1:PairedBufferLength) = outAv2%rAttr(1:nRA2,1)
+
+       ! Perform the global sum on the paired buffer
+
+  call MPI_AllReduce(PairedBuffer, OutPairedBuffer, PairedBufferLength, &
+                        MP_Type(PairedBuffer(1)), MP_SUM, comm, ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+  	      ':: Fatal Error--MPI_ALLREDUCE() failed with ierror = ',ierr
+     call MP_perr_die(myname_,'MPI_ALLREDUCE() failed',ierr)
+  endif
+
+       ! Unload OutPairedBuffer into outAv1 and outAv2:
+
+  outAv1%rAttr(1:nRA1,1) = OutPairedBuffer(1:nRA1)
+  outAv2%rAttr(1:nRA2,1) = OutPairedBuffer(nRA1+1:PairedBufferLength)
+
+       ! Clean up allocated arrays:
+
+  deallocate(PairedBuffer, OutPairedBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  'ERROR--deallocate(PairedBuffer,...) failed, ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine PairedSpatialIntegralRAttrVDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialAverageRAttrVSP_ - Do two spatial averages at once.
+!
+! !DESCRIPTION:
+! This routine computes spatial averages of the {\tt REAL} attributes
+! of the {\tt REAL} attributes of the input {\tt AttrVect} arguments 
+! {\tt inAv1} and {\tt inAv2}, returning the integrals in the output 
+! {\tt AttrVect} arguments {\tt outAv1} and {\tt outAv2}, respectively .  
+! The averages of {\tt inAv1} and {\tt inAv2} are computed using 
+! spatial weights stored in the input {\tt REAL} array arguments  
+! {\tt Weights1} and {\tt Weights2}, respectively.  This paired average 
+! is implicitly a 
+! distributed operation (the whole motivation for pairing the integrals is 
+! to reduce communication latency costs), and the Fortran MPI communicator
+! handle is defined by the input {\tt INTEGER} argument {\tt comm}.  The 
+! summation is an AllReduce operation, with all processes receiving the 
+! global sum.
+!
+! {\bf N.B.:  } The local lengths of the {\tt AttrVect} argument {\tt inAv1} 
+! and the array {\tt Weights} must be equal.  That is, there must be a 
+! one-to-one correspondence between the field point values stored 
+! in {\tt inAv1} and the spatial weights stored in {\tt Weights}
+!
+! {\bf N.B.:  } The output {\tt AttrVect} arguments {\tt outAv1} and 
+! {\tt outAv2} are allocated data structures.  The user must deallocate them
+!  using the routine {\tt AttrVect\_clean()} when they are no longer needed.  
+! Failure to do so will result in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialAverageRAttrVSP_(inAv1, outAv1, Weights1, inAv2, &
+                                       outAv2, Weights2, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : SP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN) :: inAv1
+      real(SP),dimension(:),pointer  :: Weights1
+      type(AttrVect),     intent(IN) :: inAv2
+      real(SP),dimension(:),pointer  :: Weights2
+      integer,            intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	09May02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialAverageRAttrVSP_'
+
+  type(AttrVect) :: integratedAv1, integratedAv2
+  type(List) :: nullIList
+  integer :: i, ierr, iweight1, iweight2
+
+       ! weight tags used to keep track of spatial weight sums
+  character*8, parameter :: WeightName1='WeightSum1'
+  character*8, parameter :: WeightName2='WeightSum2'
+
+       ! Compute the paired spatial integral, including spatial weights:
+
+  call PairedSpatialIntegralsV(inAv1, integratedAv1, Weights1, WeightName1, &
+                                   inAv2, integratedAv2, Weights2, WeightName2, &
+                                   .TRUE., comm)
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight1 = AttrVect_indexRA(integratedAv1, WeightName1)
+  if(integratedAv1%rAttr(iweight1, 1) == 0._FP) then   
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in first integral is zero.'
+     call die(myname_)
+  endif
+
+  iweight2 = AttrVect_indexRA(integratedAv2, WeightName2)
+  if(integratedAv2%rAttr(iweight2, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in second integral is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVects outAv1 and outAv2:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv1, iList=nullIList, rList=inAv1%rList, lsize=1)
+  call AttrVect_zero(outAv1)
+  call AttrVect_init(outAv2, iList=nullIList, rList=inAv2%rList, lsize=1)
+  call AttrVect_zero(outAv2)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv1)
+     outAv1%rAttr(i,1) = integratedAv1%rAttr(i,1) &
+	                               / integratedAv1%rAttr(iweight1,1) 
+  end do
+
+  do i=1,AttrVect_nRAttr(outAv2)
+     outAv2%rAttr(i,1) = integratedAv2%rAttr(i,1) &
+	                               / integratedAv2%rAttr(iweight2,1) 
+  end do
+
+       ! Clean up temporary AttrVects:
+
+  call AttrVect_clean(integratedAv1)
+  call AttrVect_clean(integratedAv2)
+
+ end subroutine PairedSpatialAverageRAttrVSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+! ----------------------------------------------------------------------
+!
+! !IROUTINE: PairedSpatialAverageRAttrVDP_ - Two spatial averages.
+!
+! !DESCRIPTION:
+! Double precision version of PairedSpatialAverageRAttrVSP_
+!
+! !INTERFACE:
+
+ subroutine PairedSpatialAverageRAttrVDP_(inAv1, outAv1, Weights1, inAv2, &
+                                       outAv2, Weights2, comm)
+! ! USES:
+
+      use m_stdio
+      use m_die
+      use m_mpif90
+      use m_realkinds, only : DP, FP
+
+      use m_AttrVect, only : AttrVect
+      use m_AttrVect, only : AttrVect_init => init
+      use m_AttrVect, only : AttrVect_zero => zero
+      use m_AttrVect, only : AttrVect_clean => clean
+      use m_AttrVect, only : AttrVect_lsize => lsize
+      use m_AttrVect, only : AttrVect_nRAttr => nRAttr
+      use m_AttrVect, only : AttrVect_indexRA => indexRA
+
+      use m_AttrVectReduce, only : AttrVect_LocalWeightedSumRAttr => &
+	                                         LocalWeightedSumRAttr
+
+      use m_List, only : List
+      use m_List, only : List_nullify => nullify
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(AttrVect),     intent(IN) :: inAv1
+      real(DP),dimension(:),pointer  :: Weights1
+      type(AttrVect),     intent(IN) :: inAv2
+      real(DP),dimension(:),pointer  :: Weights2
+      integer,            intent(IN) :: comm
+
+! !OUTPUT PARAMETERS:
+
+      type(AttrVect),    intent(OUT) :: outAv1
+      type(AttrVect),    intent(OUT) :: outAv2
+
+! !REVISION HISTORY:
+! 	09May02 - J.W. Larson <larson@mcs.anl.gov> - Initial version.
+!
+! ______________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::PairedSpatialAverageRAttrVDP_'
+
+  type(AttrVect) :: integratedAv1, integratedAv2
+  type(List) :: nullIList
+  integer :: i, ierr, iweight1, iweight2
+
+       ! weight tags used to keep track of spatial weight sums
+  character*8, parameter :: WeightName1='WeightSum1'
+  character*8, parameter :: WeightName2='WeightSum2'
+
+       ! Compute the paired spatial integral, including spatial weights:
+
+  call PairedSpatialIntegralsV(inAv1, integratedAv1, Weights1, WeightName1, &
+                                   inAv2, integratedAv2, Weights2, WeightName2, &
+                                   .TRUE., comm)
+
+       ! Check value of summed weights (to avoid division by zero):
+
+  iweight1 = AttrVect_indexRA(integratedAv1, WeightName1)
+  if(integratedAv1%rAttr(iweight1, 1) == 0._FP) then   
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in first integral is zero.'
+     call die(myname_)
+  endif
+
+  iweight2 = AttrVect_indexRA(integratedAv2, WeightName2)
+  if(integratedAv2%rAttr(iweight2, 1) == 0._FP) then
+     write(stderr,'(2a)') myname_, &
+	  '::ERROR--Global sum of grid weights in second integral is zero.'
+     call die(myname_)
+  endif
+
+       ! Initialize output AttrVects outAv1 and outAv2:
+
+  call List_nullify(nullIList)
+  call AttrVect_init(outAv1, iList=nullIList, rList=inAv1%rList, lsize=1)
+  call AttrVect_zero(outAv1)
+  call AttrVect_init(outAv2, iList=nullIList, rList=inAv2%rList, lsize=1)
+  call AttrVect_zero(outAv2)
+
+       ! Divide by global weight sum to compute spatial averages from 
+       ! spatial integrals.
+
+  do i=1,AttrVect_nRAttr(outAv1)
+     outAv1%rAttr(i,1) = integratedAv1%rAttr(i,1) &
+	                               / integratedAv1%rAttr(iweight1,1) 
+  end do
+
+  do i=1,AttrVect_nRAttr(outAv2)
+     outAv2%rAttr(i,1) = integratedAv2%rAttr(i,1) &
+	                               / integratedAv2%rAttr(iweight2,1) 
+  end do
+
+       ! Clean up temporary AttrVects:
+
+  call AttrVect_clean(integratedAv1)
+  call AttrVect_clean(integratedAv2)
+
+ end subroutine PairedSpatialAverageRAttrVDP_
+
+ end module m_SpatialIntegralV
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Transfer.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Transfer.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/m_Transfer.F90	(revision 4775)
@@ -0,0 +1,818 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_Transfer.F90,v 1.13 2008-01-28 06:48:03 jacob Exp
+! CVS MCT_2_8_0 
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Transfer - Routines for the MxN transfer of Attribute Vectors
+!
+! !DESCRIPTION:
+! This module provides routines for doing MxN transfer of data in an
+! Attribute Vector between two components on separate sets of MPI processes.
+! Uses the Router datatype.
+!
+! !SEE ALSO:
+! m_Rearranger
+
+! !INTERFACE:
+
+ module m_Transfer
+
+! !USES:
+  use m_MCTWorld, only : MCTWorld
+  use m_MCTWorld, only : ThisMCTWorld
+  use m_AttrVect, only : AttrVect
+  use m_AttrVect, only : nIAttr,nRAttr
+  use m_AttrVect, only : Permute, Unpermute
+  use m_AttrVect, only : AttrVect_init => init
+  use m_AttrVect, only : AttrVect_copy => copy 
+  use m_AttrVect, only : AttrVect_clean => clean
+  use m_AttrVect, only : lsize
+  use m_Router,   only : Router
+
+  use m_mpif90
+  use m_die
+  use m_stdio
+
+  implicit none
+
+  private ! except
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+  public  :: isend
+  public  :: send
+  public  :: waitsend
+  public  :: irecv
+  public  :: recv
+  public  :: waitrecv
+
+
+  interface isend    ; module procedure isend_    ; end interface
+  interface send     ; module procedure send_     ; end interface
+  interface waitsend ; module procedure waitsend_ ; end interface
+  interface irecv    ; module procedure irecv_    ; end interface
+  interface recv     ; module procedure recv_     ; end interface
+  interface waitrecv ; module procedure waitrecv_ ; end interface
+
+! !DEFINED PARAMETERS:
+
+  integer,parameter		       :: DefaultTag = 600
+
+! !REVISION HISTORY:
+! 08Nov02 - R. Jacob <jacob@mcs.anl.gov> - make new module by combining
+!           MCT_Send, MCT_Recv and MCT_Recvsum
+! 11Nov02 - R. Jacob <jacob@mcs.anl.gov> - Remove MCT_Recvsum and use
+!           optional argument in recv_ to do the same thing.
+! 23Jul03 - R. Jacob <jacob@mcs.anl.gov> - Move buffers for data and
+!           MPI_Reqest and MPI_Status arrays to Router.  Use them.
+! 24Jul03 - R. Jacob <jacob@mcs.anl.gov> - Split send_ into isend_ and
+!           waitsend_.  Redefine send_.
+! 22Jan08 - R. Jacob <jacob@mcs.anl.gov> - Handle unordered GSMaps
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT::m_Transfer'
+
+  contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: isend_ - Distributed non-blocking send of an Attribute Vector
+!
+! !DESCRIPTION:
+! Send the the data in the {\tt AttrVect} {\tt aV} to the 
+! component specified in the {\tt Router} {\tt Rout}.  An error will 
+! result if the size of the attribute vector does not match the size
+! parameter stored in the {\tt Router}.
+!
+! Requires a corresponding {\tt recv\_} or {\tt irecv\_} to be called on the other component.
+!
+! The optional argument {\tt Tag} can be used to set the tag value used in
+! the data transfer.  DefaultTag will be used otherwise. {\tt Tag} must be
+! the same in the matching {\tt recv\_} or {\tt irecv\_}.
+!
+! {\bf N.B.:} The {\tt AttrVect} argument in the corresponding
+! {\tt recv\_} call is assumed to have exactly the same attributes
+! in exactly the same order as {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine isend_(aVin, Rout, Tag)
+
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+
+      Type(AttrVect),target,intent(in)    :: aVin
+      Type(Router),         intent(inout) :: Rout
+      integer,optional,     intent(in) :: Tag
+
+! !REVISION HISTORY:
+! 07Feb01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 08Feb01 - R. Jacob <jacob@mcs.anl.gov> - First working code
+! 18May01 - R. Jacob <jacob@mcs.anl.gov> - use MP_Type to determine type in mpi_send
+! 07Jun01 - R. Jacob <jacob@mcs.anl.gov> - remove logic to check "direction" of Router.  
+!           remove references to ThisMCTWorld%mylrank
+! 03Aug01 - E. Ong <eong@mcs.anl.gov> - Explicitly specify the starting address in mpi_send.  
+! 15Feb02 - R. Jacob <jacob@mcs.anl.gov> - Use MCT_comm
+! 26Mar02 - E. Ong <eong@mcs.anl.gov> - Apply faster copy order
+! 26Sep02 - R. Jacob <jacob@mcs.anl.gov> - Check Av against Router lAvsize
+! 05Nov02 - R. Jacob <jacob@mcs.anl.gov> - Remove iList, rList arguments.
+! 08Nov02 - R. Jacob <jacob@mcs.anl.gov> - MCT_Send is now send_ in m_Transfer
+! 11Nov02 - R. Jacob <jacob@mcs.anl.gov> - Use DefaultTag and add optional Tag argument
+! 25Jul03 - R. Jacob <jacob@mcs.anl.gov> - Split into isend_ and waitsend_
+! 22Jan08 - R. Jacob <jacob@mcs.anl.gov> - Handle unordered GSMaps by permuting before send.
+!           remove special case for sending one segment directly from Av which probably
+!           wasn't safe.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::isend_'
+  integer ::	numi,numr,i,j,k,ier
+  integer ::    mycomp,othercomp
+  integer ::    AttrIndex,VectIndex,seg_start,seg_end
+  integer ::    proc,nseg,mytag
+  integer ::    mp_Type_rp1
+  logical ::    unordered
+  type(AttrVect),pointer :: Av
+  type(AttrVect),target  :: Avtmp
+
+!--------------------------------------------------------
+
+! Return if no one to send to
+  if(Rout%nprocs .eq. 0 ) RETURN
+
+! set up Av to send from
+  unordered = associated(Rout%permarr)
+  if (unordered) then
+     call AttrVect_init(Avtmp,Avin,lsize(Avin))
+     call AttrVect_copy(Avin,aVtmp)
+     call Permute(aVtmp,Rout%permarr)
+     Av => Avtmp
+  else
+     Av => Avin
+  endif
+
+!check Av size against Router
+!
+  if(lsize(aV) /= Rout%lAvsize) then
+    write(stderr,'(2a)') myname_, &
+    ' MCTERROR:  AV size not appropriate for this Router...exiting'
+    call die(myname_)
+  endif
+
+! get ids of components involved in this communication
+  mycomp=Rout%comp1id
+  othercomp=Rout%comp2id
+
+
+! find total number of real and integer vectors
+! for now, assume we are sending all of them
+  Rout%numiatt = nIAttr(aV)
+  Rout%numratt = nRAttr(aV)
+  numi = Rout%numiatt
+  numr = Rout%numratt
+
+!!!!!!!!!!!!!! IF SENDING INTEGER DATA
+  if(numi .ge. 1) then
+
+! allocate buffers to hold all outgoing data
+  do proc=1,Rout%nprocs
+     allocate(Rout%ip1(proc)%pi(Rout%locsize(proc)*numi),stat=ier)
+     if(ier/=0) call die(myname_,'allocate(Rout%ip1%pi)',ier)
+  enddo
+
+  endif
+
+!!!!!!!!!!!!!! IF SENDING REAL DATA
+  if(numr .ge. 1) then
+
+! allocate buffers to hold all outgoing data
+  do proc=1,Rout%nprocs
+     allocate(Rout%rp1(proc)%pr(Rout%locsize(proc)*numr),stat=ier)
+     if(ier/=0) call die(myname_,'allocate(Rout%rp1%pr)',ier)
+  enddo
+
+  mp_Type_rp1=MP_Type(Rout%rp1(1)%pr(1))
+
+  endif
+
+
+  ! Load data going to each processor
+  do proc = 1,Rout%nprocs
+    
+     j=1
+     k=1
+
+     ! load the correct pieces of the integer and real vectors
+     ! if Rout%num_segs(proc)=1, then this will do one loop
+     do nseg = 1,Rout%num_segs(proc)
+	 seg_start = Rout%seg_starts(proc,nseg)
+	 seg_end = seg_start + Rout%seg_lengths(proc,nseg)-1
+	 do VectIndex = seg_start,seg_end
+	    do AttrIndex = 1,numi
+	        Rout%ip1(proc)%pi(j) = aV%iAttr(AttrIndex,VectIndex)
+		j=j+1
+	    enddo
+	    do AttrIndex = 1,numr
+	        Rout%rp1(proc)%pr(k) = aV%rAttr(AttrIndex,VectIndex)
+	        k=k+1
+	    enddo
+	 enddo
+     enddo
+
+
+
+     ! Send the integer data
+     if(numi .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag
+        if(present(Tag)) mytag=Tag
+
+
+	call MPI_ISEND(Rout%ip1(proc)%pi(1), &
+	     Rout%locsize(proc)*numi,MP_INTEGER,Rout%pe_list(proc), &
+	     mytag,ThisMCTWorld%MCT_comm,Rout%ireqs(proc),ier)
+	   
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_ISEND(ints)',ier)
+
+     endif
+
+     ! Send the real data
+     if(numr .ge. 1) then
+
+       ! set tag
+       mytag = DefaultTag + 1 
+       if(present(Tag)) mytag=Tag +1
+
+
+       call MPI_ISEND(Rout%rp1(proc)%pr(1), &
+	    Rout%locsize(proc)*numr,mp_Type_rp1,Rout%pe_list(proc), &
+	    mytag,ThisMCTWorld%MCT_comm,Rout%rreqs(proc),ier)
+
+
+       if(ier /= 0) call MP_perr_die(myname_,'MPI_ISEND(reals)',ier)
+
+    endif
+
+  enddo
+
+  if (unordered) then
+     call AttrVect_clean(aVtmp)
+     nullify(aV)
+  else
+     nullify(aV)
+  endif
+
+end subroutine isend_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: waitsend_ - Wait for a distributed non-blocking send to complete
+!
+! !DESCRIPTION:
+! Wait for the data being sent with the {\tt Router} {\tt Rout} to complete.
+!
+! !INTERFACE:
+
+ subroutine waitsend_(Rout)
+
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      Type(Router),         intent(inout) :: Rout
+
+! !REVISION HISTORY:
+! 24Jul03 - R. Jacob <jacob@mcs.anl.gov> - First working version is
+!           the wait part of original send_
+!EOP ___________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::waitsend_'
+  integer ::   proc,ier
+
+! Return if nothing to wait for
+  if(Rout%nprocs .eq. 0 ) RETURN
+
+  ! wait for all sends to complete
+  if(Rout%numiatt .ge. 1) then
+
+     call MPI_WAITALL(Rout%nprocs,Rout%ireqs,Rout%istatus,ier)
+     if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(ints)',ier)
+
+     do proc=1,Rout%nprocs
+	deallocate(Rout%ip1(proc)%pi,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(ip1%pi)',ier)
+     enddo
+
+  endif
+
+  if(Rout%numratt .ge. 1) then
+
+     call MPI_WAITALL(Rout%nprocs,Rout%rreqs,Rout%rstatus,ier)
+     if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(reals)',ier)
+
+     do proc=1,Rout%nprocs
+	deallocate(Rout%rp1(proc)%pr,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(rp1%pi)',ier)
+     enddo
+
+  endif
+
+
+end subroutine waitsend_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: send_ - Distributed blocking send of an Attribute Vector
+!
+! !DESCRIPTION:
+! Send the the data in the {\tt AttrVect} {\tt aV} to the 
+! component specified in the {\tt Router} {\tt Rout}.  An error will 
+! result if the size of the attribute vector does not match the size
+! parameter stored in the {\tt Router}.
+!
+! Requires a corresponding {\tt recv\_} or {\tt irecv\_} to be called on the other
+! component.
+!
+! The optional argument {\tt Tag} can be used to set the tag value used in
+! the data transfer.  DefaultTag will be used otherwise. {\tt Tag} must be
+! the same in the matching {\tt recv\_} or {\tt irecv\_}.
+!
+! {\bf N.B.:} The {\tt AttrVect} argument in the corresponding
+! {\tt recv} call is assumed to have exactly the same attributes
+! in exactly the same order as {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine send_(aV, Rout, Tag)
+
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+
+      Type(AttrVect),       intent(in)    :: aV	
+      Type(Router),         intent(inout) :: Rout
+      integer,optional,     intent(in)    :: Tag
+
+! !REVISION HISTORY:
+! 24Jul03 - R. Jacob <jacob@mcs.anl.gov> - New version uses isend and waitsend
+!EOP ___________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::send_'
+
+  call isend_(aV,Rout,Tag)
+
+  call waitsend_(Rout)
+
+end subroutine send_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: irecv_ - Distributed receive of an Attribute Vector
+!
+! !DESCRIPTION:
+! Recieve into the {\tt AttrVect} {\tt aV} the data coming from the 
+! component specified in the {\tt Router} {\tt Rout}.  An error will 
+! result if the size of the attribute vector does not match the size
+! parameter stored in the {\tt Router}.
+!
+! Requires a corresponding {\tt send\_} or {\tt isend\_} to be called 
+! on the other component.
+!
+! The optional argument {\tt Tag} can be used to set the tag value used in
+! the data transfer.  DefaultTag will be used otherwise. {\tt Tag} must be
+! the same in the matching {\tt send\_} or {\tt isend\_}.
+!
+! If data for a grid point is coming from more than one process, {\tt recv\_}
+! will overwrite the duplicate values leaving the last received value
+! in the output aV.  If the optional argument {\tt Sum} is invoked, the output
+! will contain the sum of any duplicate values received for the same grid point.
+!
+! Will return as soon as MPI\_IRECV's are posted.  Call {\tt waitrecv\_} to
+! complete the receive operation.
+!
+! {\bf N.B.:} The {\tt AttrVect} argument in the corresponding
+! {\tt send\_} call is assumed to have exactly the same attributes
+! in exactly the same order as {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine irecv_(aV, Rout, Tag, Sum)
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      Type(AttrVect),       intent(inout) :: aV
+
+! !INPUT PARAMETERS:
+!
+      Type(Router),         intent(inout) :: Rout
+      integer,optional,     intent(in)    :: Tag
+      logical,optional,     intent(in)    :: Sum
+
+! !REVISION HISTORY:
+! 07Feb01 - R. Jacob <jacob@mcs.anl.gov> - initial prototype
+! 07Jun01 - R. Jacob <jacob@mcs.anl.gov> - remove logic to
+!           check "direction" of Router.  remove references
+!           to ThisMCTWorld%mylrank
+! 03Aug01 - E.T. Ong <eong@mcs.anl.gov> - explicity specify starting
+!           address in MPI_RECV
+! 27Nov01 - E.T. Ong <eong@mcs.anl.gov> - deallocated to prevent
+!           memory leaks
+! 15Feb02 - R. Jacob <jacob@mcs.anl.gov> - Use MCT_comm
+! 26Mar02 - E. Ong <eong@mcs.anl.gov> - Apply faster copy order.
+! 26Sep02 - R. Jacob <jacob@mcs.anl.gov> - Check Av against Router lAvsize
+! 08Nov02 - R. Jacob <jacob@mcs.anl.gov> - MCT_Recv is now recv_ in m_Transfer
+! 11Nov02 - R. Jacob <jacob@mcs.anl.gov> - Add optional Sum argument to
+!           tell recv_ to sum data for the same point received from multiple
+!           processors.  Replaces recvsum_ which had replaced MCT_Recvsum.
+!           Use DefaultTag and add optional Tag argument
+! 25Jul03 - R. Jacob <jacob@mcs.anl.gov> - break into irecv_ and waitrecv_
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::irecv_'
+  integer ::	numi,numr,i,j,k,ier
+  integer ::    mycomp,othercomp
+  integer ::    seg_start,seg_end
+  integer ::    proc,numprocs,nseg,mytag
+  integer ::    mp_Type_rp1
+  logical ::    DoSum
+
+!--------------------------------------------------------
+
+! Return if no one to receive from
+  if(Rout%nprocs .eq. 0 ) RETURN
+
+!check Av size against Router
+!
+  if(lsize(aV) /= Rout%lAvsize) then
+    write(stderr,'(2a)') myname_, &
+    ' MCTERROR:  AV size not appropriate for this Router...exiting'
+    call die(myname_)
+  endif
+
+  DoSum = .false.
+  if(present(Sum)) DoSum=Sum
+
+
+  mycomp=Rout%comp1id
+  othercomp=Rout%comp2id
+
+!  find total number of real and integer vectors
+! for now, assume we are receiving all of them
+  Rout%numiatt = nIAttr(aV)
+  Rout%numratt = nRAttr(aV)
+  numi = Rout%numiatt
+  numr = Rout%numratt
+
+!!!!!!!!!!!!!! IF RECEVING INTEGER DATA
+  if(numi .ge. 1) then
+
+! allocate buffers to hold all incoming data
+  do proc=1,Rout%nprocs
+     allocate(Rout%ip1(proc)%pi(Rout%locsize(proc)*numi),stat=ier)
+     if(ier/=0) call die(myname_,'allocate(Rout%ip1%pi)',ier)
+  enddo
+
+  endif
+
+!!!!!!!!!!!!!! IF RECEIVING REAL DATA
+  if(numr .ge. 1) then
+
+! allocate buffers to hold all incoming data
+  do proc=1,Rout%nprocs
+     allocate(Rout%rp1(proc)%pr(Rout%locsize(proc)*numr),stat=ier)
+     if(ier/=0) call die(myname_,'allocate(Rout%rp1%pr)',ier)
+  enddo
+
+  mp_Type_rp1=MP_Type(Rout%rp1(1)%pr(1))
+
+  endif
+
+  ! Post all MPI_IRECV
+  do proc=1,Rout%nprocs
+
+     ! receive the integer data
+     if(numi .ge. 1) then
+
+        ! set tag
+        mytag = DefaultTag
+        if(present(Tag)) mytag=Tag
+
+	if( Rout%num_segs(proc) > 1 .or. DoSum ) then
+
+	   call MPI_IRECV(Rout%ip1(proc)%pi(1), &
+		Rout%locsize(proc)*numi,MP_INTEGER,Rout%pe_list(proc), &
+		mytag,ThisMCTWorld%MCT_comm,Rout%ireqs(proc),ier)
+
+	else
+
+	   call MPI_IRECV(aV%iAttr(1,Rout%seg_starts(proc,1)), &
+		Rout%locsize(proc)*numi,MP_INTEGER,Rout%pe_list(proc), &
+		mytag,ThisMCTWorld%MCT_comm,Rout%ireqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV(ints)',ier)
+
+     endif
+
+     ! receive the real data
+     if(numr .ge. 1) then
+
+	! corresponding tag logic must be in send_
+        mytag = DefaultTag + 1
+        if(present(Tag)) mytag=Tag +1
+
+	if( Rout%num_segs(proc) > 1 .or. DoSum ) then
+
+	   call MPI_IRECV(Rout%rp1(proc)%pr(1), &
+		Rout%locsize(proc)*numr,mp_Type_rp1,Rout%pe_list(proc), &
+		mytag,ThisMCTWorld%MCT_comm,Rout%rreqs(proc),ier)
+
+	else
+
+	   call MPI_IRECV(aV%rAttr(1,Rout%seg_starts(proc,1)), &
+		Rout%locsize(proc)*numr,mp_Type_rp1,Rout%pe_list(proc), &
+		mytag,ThisMCTWorld%MCT_comm,Rout%rreqs(proc),ier)
+
+	endif
+
+	if(ier /= 0) call MP_perr_die(myname_,'MPI_IRECV(reals)',ier)
+
+     endif
+
+  enddo
+
+end subroutine irecv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: waitrecv_ - Wait for a distributed non-blocking recv to complete
+!
+! !DESCRIPTION:
+! Wait for the data being received with the {\tt Router} {\tt Rout} to complete.
+! When done, copy the data into the {\tt AttrVect} {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine waitrecv_(aV, Rout, Sum)
+
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      Type(AttrVect),       intent(inout) :: aV
+      Type(Router),         intent(inout) :: Rout
+
+! !INPUT PARAMETERS:
+!
+      logical,optional,     intent(in)    :: Sum
+
+
+! !REVISION HISTORY:
+! 25Jul03 - R. Jacob <jacob@mcs.anl.gov> - First working version is the wait
+!           and copy parts from old recv_.
+! 25Jan08 - R. Jacob <jacob@mcs.anl.gov> - Handle unordered GSMaps by
+!           applying permutation to received array.
+!EOP ___________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::waitrecv_'
+  integer ::   proc,ier,j,k,nseg
+  integer ::   AttrIndex,VectIndex,seg_start,seg_end
+  logical ::   DoSum
+  logical ::   unordered
+
+! Return if nothing to wait for
+  if(Rout%nprocs .eq. 0 ) RETURN
+
+!check Av size against Router
+!
+  if(lsize(aV) /= Rout%lAvsize) then
+    write(stderr,'(2a)') myname_, &
+    ' MCTERROR:  AV size not appropriate for this Router...exiting'
+    call die(myname_)
+  endif
+
+  unordered = associated(Rout%permarr)
+
+  DoSum = .false.
+  if(present(Sum)) DoSum=Sum
+
+  ! wait for all recieves to complete
+  if(Rout%numiatt .ge. 1)  then
+
+    call MPI_WAITALL(Rout%nprocs,Rout%ireqs,Rout%istatus,ier)
+    if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(ints)',ier)
+
+  endif
+
+  if(Rout%numratt .ge. 1) then
+
+    call MPI_WAITALL(Rout%nprocs,Rout%rreqs,Rout%rstatus,ier)
+    if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITALL(reals)',ier)
+
+  endif
+
+  ! Load data which came from each processor
+  do proc=1,Rout%nprocs
+
+     if( (Rout%num_segs(proc) > 1) .or. DoSum ) then
+
+        j=1
+	k=1
+
+	if(DoSum) then
+	! sum the correct pieces of the integer and real vectors
+	  do nseg = 1,Rout%num_segs(proc)
+	   seg_start = Rout%seg_starts(proc,nseg)
+	   seg_end = seg_start + Rout%seg_lengths(proc,nseg)-1
+	   do VectIndex = seg_start,seg_end
+	      do AttrIndex = 1,Rout%numiatt
+		 aV%iAttr(AttrIndex,VectIndex)= &
+		 aV%iAttr(AttrIndex,VectIndex)+Rout%ip1(proc)%pi(j)
+		 j=j+1
+	      enddo
+	      do AttrIndex = 1,Rout%numratt
+		 aV%rAttr(AttrIndex,VectIndex)= &
+		 aV%rAttr(AttrIndex,VectIndex)+Rout%rp1(proc)%pr(k)
+		 k=k+1
+	      enddo
+	   enddo
+	  enddo
+	else
+	! load the correct pieces of the integer and real vectors
+	  do nseg = 1,Rout%num_segs(proc)
+	   seg_start = Rout%seg_starts(proc,nseg)
+	   seg_end = seg_start + Rout%seg_lengths(proc,nseg)-1
+	   do VectIndex = seg_start,seg_end
+	      do AttrIndex = 1,Rout%numiatt
+		 aV%iAttr(AttrIndex,VectIndex)=Rout%ip1(proc)%pi(j)
+		 j=j+1
+	      enddo
+	      do AttrIndex = 1,Rout%numratt
+		 aV%rAttr(AttrIndex,VectIndex)=Rout%rp1(proc)%pr(k)
+		 k=k+1
+	      enddo
+	   enddo
+	  enddo
+        endif
+	
+     endif
+
+  enddo
+
+!........................WAITANY METHOD................................
+!
+!....NOTE: Make status argument a 1-dimensional array
+!  ! Load data which came from each processor
+!  do numprocs = 1,Rout%nprocs
+!     ! Load the integer data
+!     if(Rout%numiatt .ge. 1) then
+!	call MPI_WAITANY(Rout%nprocs,Rout%ireqs,proc,Rout%istatus,ier)
+!	if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITANY(ints)',ier)
+!	j=1
+!	! load the correct pieces of the integer vectors
+!	do nseg = 1,Rout%num_segs(proc)
+!	   seg_start = Rout%seg_starts(proc,nseg)
+!	   seg_end = seg_start + Rout%seg_lengths(proc,nseg)-1
+!	   do VectIndex = seg_start,seg_end
+!	      do AttrIndex = 1,Rout%numiatt
+!		 aV%iAttr(AttrIndex,VectIndex)=Rout%ip1(proc)%pi(j)
+!		 j=j+1
+!	      enddo
+!	   enddo
+!	enddo
+!     endif
+!     ! Load the real data
+!     if(numr .ge. 1) then
+!	call MPI_WAITANY(Rout%nprocs,Rout%rreqs,proc,Rout%rstatus,ier)
+!	if(ier /= 0) call MP_perr_die(myname_,'MPI_WAITANY(reals)',ier)
+!	k=1
+!	! load the correct pieces of the real vectors
+!	do nseg = 1,Rout%num_segs(proc)
+!	   seg_start = Rout%seg_starts(proc,nseg)
+!	   seg_end = seg_start + Rout%seg_lengths(proc,nseg)-1
+!	   do VectIndex = seg_start,seg_end
+!	      do AttrIndex = 1,numr
+!		 aV%rAttr(AttrIndex,VectIndex)=Rout%rp1(proc)%pr(k)
+!		 k=k+1
+!	      enddo
+!	   enddo
+!	enddo
+!     endif
+!  enddo
+!........................................................................
+
+  ! Deallocate all structures
+  if(Rout%numiatt .ge. 1) then
+
+     ! Deallocate the receive buffers
+     do proc=1,Rout%nprocs
+	deallocate(Rout%ip1(proc)%pi,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(Rout%ip1%pi)',ier)
+     enddo
+
+  endif
+
+  if(Rout%numratt .ge. 1) then
+
+     ! Deallocate the receive buffers
+     do proc=1,Rout%nprocs
+	deallocate(Rout%rp1(proc)%pr,stat=ier)
+	if(ier/=0) call die(myname_,'deallocate(Rout%rp1%pr)',ier)
+     enddo
+
+  endif
+
+  if (unordered) call Unpermute(aV,Rout%permarr)
+
+end subroutine waitrecv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: recv_ - Distributed receive of an Attribute Vector
+!
+! !DESCRIPTION:
+! Recieve into the {\tt AttrVect} {\tt aV} the data coming from the 
+! component specified in the {\tt Router} {\tt Rout}.  An error will 
+! result if the size of the attribute vector does not match the size
+! parameter stored in the {\tt Router}.
+!
+! Requires a corresponding {\tt send\_} or {\tt isend\_}to be called 
+! on the other component.
+!
+! The optional argument {\tt Tag} can be used to set the tag value used in
+! the data transfer.  DefaultTag will be used otherwise. {\tt Tag} must be
+! the same in the matching {\tt send\_}
+!
+! If data for a grid point is coming from more than one process, {\tt recv\_}
+! will overwrite the duplicate values leaving the last received value
+! in the output aV.  If the optional argument {\tt Sum} is invoked, the output
+! will contain the sum of any duplicate values received for the same grid point.
+!
+! Will not return until all data has been received.
+!
+! {\bf N.B.:} The {\tt AttrVect} argument in the corresponding
+! {\tt send\_} call is assumed to have exactly the same attributes
+! in exactly the same order as {\tt aV}.
+!
+! !INTERFACE:
+
+ subroutine recv_(aV, Rout, Tag, Sum)
+!
+! !USES:
+!
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+!
+      Type(AttrVect),       intent(inout) :: aV
+
+! !INPUT PARAMETERS:
+!
+      Type(Router),         intent(inout)    :: Rout
+      integer,optional,     intent(in)    :: Tag
+      logical,optional,     intent(in)    :: Sum
+
+! !REVISION HISTORY:
+! 25Jul03 - R. Jacob <jacob@mcs.anl.gov> - Rewrite using irecv and waitrecv
+!EOP ___________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::recv_'
+
+  call irecv_(aV,Rout,Tag,Sum)
+
+  call waitrecv_(aV,Rout,Sum)
+
+end subroutine recv_
+
+
+end module m_Transfer
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/mct_mod.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/mct_mod.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mct/mct_mod.F90	(revision 4775)
@@ -0,0 +1,135 @@
+module mct_mod
+
+! !USES:
+   use m_MCTWorld           ,only: mct_world_init         => init
+
+   use m_AttrVect           ,only: mct_aVect              => AttrVect
+   use m_AttrVect           ,only: mct_aVect_init         => init
+   use m_AttrVect           ,only: mct_aVect_clean        => clean
+   use m_AttrVect           ,only: mct_aVect_zero         => zero
+   use m_AttrVect           ,only: mct_aVect_lsize        => lsize
+   use m_AttrVect           ,only: mct_aVect_indexIA      => indexIA
+   use m_AttrVect           ,only: mct_aVect_indexRA      => indexRA
+   use m_AttrVect           ,only: mct_aVect_importRattr  => importRattr
+   use m_AttrVect           ,only: mct_aVect_exportRattr  => exportRattr
+   use m_AttrVect           ,only: mct_aVect_getIList     => getIList
+   use m_AttrVect           ,only: mct_aVect_getRList     => getRList
+   use m_AttrVect           ,only: mct_aVect_exportIList2c=> exportIListToChar
+   use m_AttrVect           ,only: mct_aVect_exportRList2c=> exportRListToChar
+   use m_AttrVect           ,only: mct_aVect_nIAttr       => nIAttr
+   use m_AttrVect           ,only: mct_aVect_nRAttr       => nRAttr
+   use m_AttrVect           ,only: mct_aVect_copy         => Copy
+   use m_AttrVect           ,only: mct_aVect_permute      => Permute
+   use m_AttrVect           ,only: mct_aVect_unpermute    => Unpermute
+   use m_AttrVectComms      ,only: mct_aVect_scatter      => scatter
+   use m_AttrVectComms      ,only: mct_aVect_gather       => gather 
+   use m_AttrVectComms      ,only: mct_aVect_bcast        => bcast  
+
+   use m_Accumulator        ,only: mct_accum              => Accumulator
+   use m_Accumulator        ,only: mct_accum_init         => init
+   use m_Accumulator        ,only: mct_accum_zero         => zero
+   use m_Accumulator        ,only: mct_accum_accumulate   => accumulate
+!   use m_Accumulator        ,only: mct_accum_average      => average
+
+   use m_GeneralGrid        ,only: mct_gGrid              => GeneralGrid
+   use m_GeneralGrid        ,only: mct_gGrid_init         => init
+   use m_GeneralGrid        ,only: mct_gGrid_clean        => clean
+   use m_GeneralGrid        ,only: mct_gGrid_dims         => dims
+   use m_GeneralGrid        ,only: mct_gGrid_lsize        => lsize
+   use m_GeneralGrid        ,only: mct_ggrid_indexIA      => indexIA
+   use m_GeneralGrid        ,only: mct_gGrid_indexRA      => indexRA
+   use m_GeneralGrid        ,only: mct_gGrid_exportRattr  => exportRattr
+   use m_GeneralGrid        ,only: mct_gGrid_importRattr  => importRattr
+   use m_GeneralGrid        ,only: mct_gGrid_exportIattr  => exportIattr
+   use m_GeneralGrid        ,only: mct_gGrid_importIattr  => importIattr
+   use m_GeneralGrid        ,only: mct_gGrid_permute      => permute
+   use m_GeneralGridComms   ,only: mct_gGrid_scatter      => scatter
+   use m_GeneralGridComms   ,only: mct_gGrid_gather       => gather 
+   use m_GeneralGridComms   ,only: mct_gGrid_bcast        => bcast  
+
+   use m_Transfer           ,only: mct_send               => Send
+   use m_Transfer           ,only: mct_isend              => iSend
+   use m_Transfer           ,only: mct_waitsend           => WaitSend
+   use m_Transfer           ,only: mct_recv               => Recv
+   use m_Transfer           ,only: mct_irecv              => iRecv
+   use m_Transfer           ,only: mct_waitrecv           => WaitRecv
+      
+   use m_GlobalSegMap       ,only: mct_gsMap              => GlobalSegMap
+   use m_GlobalSegMap       ,only: mct_gsMap_init         => init
+   use m_GlobalSegMap       ,only: mct_gsMap_clean        => clean
+   use m_GlobalSegMap       ,only: mct_gsMap_lsize        => lsize
+   use m_GlobalSegMap       ,only: mct_gsMap_gsize        => gsize
+   use m_GlobalSegMap       ,only: mct_gsMap_gstorage     => GlobalStorage
+   use m_GlobalSegMap       ,only: mct_gsMap_ngseg        => ngseg
+   use m_GlobalSegMap       ,only: mct_gsMap_nlseg        => nlseg
+   use m_GlobalSegMap       ,only: mct_gsMap_maxnlseg     => max_nlseg
+   use m_GlobalSegMap       ,only: mct_gsMap_activepes    => active_pes
+   use m_GlobalSegMap       ,only: mct_gsMap_copy         => copy
+   use m_GlobalSegMap       ,only: mct_gsMap_increasing   => increasing
+   use m_GlobalSegMap       ,only: mct_gsMap_orderedPoints=> OrderedPoints
+   use m_GlobalSegMapComms  ,only: mct_gsMap_bcast        => bcast 
+
+   use m_Rearranger         ,only: mct_rearr              => Rearranger
+   use m_Rearranger         ,only: mct_rearr_init         => init
+   use m_Rearranger         ,only: mct_rearr_clean        => clean
+   use m_Rearranger         ,only: mct_rearr_print        => print
+   use m_Rearranger         ,only: mct_rearr_rearrange    => rearrange
+
+   use m_Router             ,only: mct_router             => Router
+   use m_Router             ,only: mct_router_init        => init
+
+   use m_SparseMatrixToMaps ,only: mct_sMat_2XgsMap       => SparseMatrixToXGlobalSegMap
+   use m_SparseMatrixToMaps ,only: mct_sMat_2YgsMap       => SparseMatrixToYGlobalSegMap
+   use m_SparseMatrix       ,only: mct_sMat               => SparseMatrix
+   use m_SparseMatrix       ,only: mct_sMat_Init          => init
+   use m_SparseMatrix       ,only: mct_sMat_Vecinit       => vecinit
+   use m_SparseMatrix       ,only: mct_sMat_Clean         => clean
+   use m_SparseMatrix       ,only: mct_sMat_indexIA       => indexIA
+   use m_SparseMatrix       ,only: mct_sMat_indexRA       => indexRA
+   use m_SparseMatrix       ,only: mct_sMat_lsize         => lsize
+   use m_SparseMatrix       ,only: mct_sMat_nrows         => nRows
+   use m_SparseMatrix       ,only: mct_sMat_ncols         => nCols
+   use m_SparseMatrix       ,only: mct_sMat_SortPermute   => SortPermute
+   use m_SparseMatrix       ,only: mct_sMat_GNumEl        => GlobalNumElements
+   use m_SparseMatrix       ,only: mct_sMat_ImpGRowI      => ImportGlobalRowIndices
+   use m_SparseMatrix       ,only: mct_sMat_ImpGColI      => ImportGlobalColumnIndices
+   use m_SparseMatrix       ,only: mct_sMat_ImpLRowI      => ImportLocalRowIndices
+   use m_SparseMatrix       ,only: mct_sMat_ImpLColI      => ImportLocalColumnIndices
+   use m_SparseMatrix       ,only: mct_sMat_ImpMatrix     => ImportMatrixElements
+   use m_SparseMatrix       ,only: mct_sMat_ExpGRowI      => ExportGlobalRowIndices
+   use m_SparseMatrix       ,only: mct_sMat_ExpGColI      => ExportGlobalColumnIndices
+   use m_SparseMatrix       ,only: mct_sMat_ExpLRowI      => ExportLocalRowIndices
+   use m_SparseMatrix       ,only: mct_sMat_ExpLColI      => ExportLocalColumnIndices
+   use m_SparseMatrix       ,only: mct_sMat_ExpMatrix     => ExportMatrixElements
+   use m_SparseMatrixComms  ,only: mct_sMat_ScatterByRow  => ScatterByRow
+   use m_SparseMatrixComms  ,only: mct_sMat_ScatterByCol  => ScatterByColumn
+   use m_SparseMatrixPlus   ,only: mct_sMatP              => SparseMatrixPlus
+   use m_SparseMatrixPlus   ,only: mct_sMatP_Init         => init
+   use m_SparseMatrixPlus   ,only: mct_sMatP_Vecinit      => vecinit
+   use m_SparseMatrixPlus   ,only: mct_sMatP_clean        => clean
+   use m_MatAttrVectMul     ,only: mct_sMat_avMult        => sMatAvMult
+   use m_GlobalToLocal      ,only: mct_sMat_g2lMat        => GlobalToLocalMatrix
+
+   use m_List               ,only: mct_list               => list     
+   use m_List               ,only: mct_list_init          => init
+   use m_List               ,only: mct_list_get           => get 
+   use m_List               ,only: mct_list_nitem         => nitem 
+   use m_List               ,only: mct_list_clean         => clean
+   use m_string             ,only: mct_string             => string 
+   use m_string             ,only: mct_string_clean       => clean
+   use m_string             ,only: mct_string_toChar      => toChar 
+   use m_die                ,only: mct_perr_die           => mp_perr_die
+   use m_die                ,only: mct_die                => die
+   use m_inpak90
+
+
+   use m_Permuter           ,only: mct_permute            => Permute
+
+   use m_MergeSorts         ,only: mct_indexset           => IndexSet
+   use m_MergeSorts         ,only: mct_indexsort          => IndexSort
+
+   implicit none
+
+!===============================================================================
+
+end module mct_mod
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mkinstalldirs
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mkinstalldirs	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mkinstalldirs	(revision 4775)
@@ -0,0 +1,111 @@
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Public domain
+
+errstatus=0
+dirmode=""
+
+usage="\
+Usage: mkinstalldirs [-h] [--help] [-m mode] dir ..."
+
+# process command line arguments
+while test $# -gt 0 ; do
+  case $1 in
+    -h | --help | --h*)         # -h for help
+      echo "$usage" 1>&2
+      exit 0
+      ;;
+    -m)                         # -m PERM arg
+      shift
+      test $# -eq 0 && { echo "$usage" 1>&2; exit 1; }
+      dirmode=$1
+      shift
+      ;;
+    --)                         # stop option processing
+      shift
+      break
+      ;;
+    -*)                         # unknown option
+      echo "$usage" 1>&2
+      exit 1
+      ;;
+    *)                          # first non-opt arg
+      break
+      ;;
+  esac
+done
+
+for file
+do
+  if test -d "$file"; then
+    shift
+  else
+    break
+  fi
+done
+
+case $# in
+  0) exit 0 ;;
+esac
+
+case $dirmode in
+  '')
+    if mkdir -p -- . 2>/dev/null; then
+      echo "mkdir -p -- $*"
+      exec mkdir -p -- "$@"
+    fi
+    ;;
+  *)
+    if mkdir -m "$dirmode" -p -- . 2>/dev/null; then
+      echo "mkdir -m $dirmode -p -- $*"
+      exec mkdir -m "$dirmode" -p -- "$@"
+    fi
+    ;;
+esac
+
+for file
+do
+  set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+  shift
+
+  pathcomp=
+  for d
+  do
+    pathcomp="$pathcomp$d"
+    case $pathcomp in
+      -*) pathcomp=./$pathcomp ;;
+    esac
+
+    if test ! -d "$pathcomp"; then
+      echo "mkdir $pathcomp"
+
+      mkdir "$pathcomp" || lasterr=$?
+
+      if test ! -d "$pathcomp"; then
+  	errstatus=$lasterr
+      else
+  	if test ! -z "$dirmode"; then
+	  echo "chmod $dirmode $pathcomp"
+    	  lasterr=""
+  	  chmod "$dirmode" "$pathcomp" || lasterr=$?
+
+  	  if test ! -z "$lasterr"; then
+  	    errstatus=$lasterr
+  	  fi
+  	fi
+      fi
+    fi
+
+    pathcomp="$pathcomp/"
+  done
+done
+
+exit $errstatus
+
+# Local Variables:
+# mode: shell-script
+# sh-indentation: 2
+# End:
+# mkinstalldirs ends here
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/.cvsignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/.cvsignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/.cvsignore	(revision 4775)
@@ -0,0 +1,1 @@
+*.mod mpeu Makefile.conf *.lst
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/Makefile	(revision 4775)
@@ -0,0 +1,125 @@
+.NOTPARALLEL:
+# MACHINE AND COMPILER FLAGS
+
+include ../Makefile.conf
+
+VPATH = $(SRCDIR)/mpeu
+SHELL           = /bin/sh
+
+INCPATH += $(INCFLAG). $(INCFLAG)../
+
+# SOURCE FILES
+
+MODULE		= mpeu
+
+SRCS_F90	= m_IndexBin_char.F90		\
+		  m_IndexBin_integer.F90	\
+		  m_IndexBin_logical.F90	\
+		  m_List.F90			\
+		  m_MergeSorts.F90		\
+		  m_Filename.F90		\
+		  m_FcComms.F90                 \
+		  m_Permuter.F90		\
+		  m_SortingTools.F90		\
+		  m_String.F90			\
+		  m_StrTemplate.F90		\
+		  m_chars.F90			\
+		  m_die.F90			\
+		  m_dropdead.F90		\
+                  m_FileResolv.F90		\
+		  m_flow.F90			\
+		  m_inpak90.F90			\
+		  m_ioutil.F90			\
+		  m_mall.F90			\
+		  m_mpif.F90			\
+		  m_mpif90.F90			\
+		  m_mpout.F90			\
+		  m_rankMerge.F90		\
+		  m_realkinds.F90		\
+		  m_stdio.F90			\
+		  m_TraceBack.F90		\
+		  m_zeit.F90
+
+SRCS_C		= get_zeits.c
+
+OBJS_ALL	= $(SRCS_C:.c=.o)  \
+		  $(SRCS_F90:.F90=.o)
+
+
+# TARGETS
+
+all:	lib$(MODULE).a
+
+lib$(MODULE).a:	$(OBJS_ALL)
+	$(RM) $@
+	$(AR) $@ $(OBJS_ALL)
+
+# ADDITIONAL FLAGS SPECIFIC FOR MPEU COMPILATION
+
+MPEUFLAGS =
+
+# RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .c .o
+
+.c.o:
+	$(CC) -c $(CPPDEFS) $(CFLAGS) $(INCPATH) $<
+
+.F90.o:
+	$(FC) -c $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MPEUFLAGS) $<
+
+clean:
+	${RM} *.o *.mod lib$(MODULE).a
+
+install: all
+	$(MKINSTALLDIRS) $(libdir) $(includedir)
+	$(INSTALL) lib$(MODULE).a -m 644 $(libdir)
+	@for modfile in *.mod; do                         \
+	  echo $(INSTALL) $$modfile -m 644 $(includedir); \
+	  $(INSTALL) $$modfile -m 644 $(includedir);      \
+	done
+
+# DEPENDENCIES
+
+m_IndexBin_char.o: m_die.o m_stdio.o
+m_IndexBin_integer.o: m_die.o m_stdio.o
+m_IndexBin_logical.o: m_die.o m_stdio.o
+m_List.o: m_String.o m_die.o m_mall.o
+m_MergeSorts.o: m_die.o m_realkinds.o m_stdio.o
+m_Filename.o:
+m_Permuter.o: m_die.o m_realkinds.o
+m_SortingTools.o: m_IndexBin_char.o m_IndexBin_integer.o m_IndexBin_logical.o m_MergeSorts.o m_Permuter.o m_rankMerge.o
+m_String.o: m_die.o m_mall.o m_mpif90.o
+m_StrTemplate.o: m_chars.o m_die.o m_stdio.o
+m_chars.o:
+m_die.o: m_dropdead.o m_flow.o m_mpif90.o m_mpout.o m_stdio.o
+m_dropdead.o: m_mpif90.o m_stdio.o
+m_flow.o: m_chars.o
+m_inpak90.o: m_die.o m_ioutil.o m_mall.o m_mpif90.o m_realkinds.o m_stdio.o
+m_ioutil.o: m_stdio.o
+m_mall.o: m_chars.o m_die.o m_ioutil.o m_realkinds.o m_stdio.o
+m_mpif.o:
+m_mpif90.o: m_mpif.o m_realkinds.o m_stdio.o
+m_mpout.o: m_dropdead.o m_ioutil.o m_mpif90.o m_stdio.o
+m_rankMerge.o:
+m_realkinds.o:
+m_stdio.o:
+m_zeit.o: m_SortingTools.o m_die.o m_ioutil.o m_mpif90.o m_stdio.o get_zeits.o
+get_zeits.o:
+m_FileResolv.o: m_die.o m_StrTemplate.o
+m_TraceBack.o:	m_die.o m_stdio.o m_String.o
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/README	(revision 4775)
@@ -0,0 +1,59 @@
+!-----------------------------------------------------------------------
+! CVS README,v 1.5 2004-04-23 22:00:55 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+
+This directory contains a version of MPEU distributed as part 
+of the Model Coupling Toolkit (MCT).  MPEU was written by
+Jing Guo of the NASA Data Assimilation Office. 
+
+This copy of MPEU provided by Jing Guo.  Usage is covered
+by terms in the file MCT/COPYRIGHT.
+
+MCT distribution contents:
+MCT/
+MCT/COPYRIGHT
+MCT/doc/
+MCT/examples/
+MCT/mct/
+MCT/mpeu/   <- You are here
+MCT/protex/
+
+A complete distribution of MCT can be obtained from http://www.mcs.anl.gov/mct.
+
+---------------------------------------------------
+Build instructions:
+
+In top level directory, type "./configure", then "make".
+
+If "./configure" has already been run, you can also type "make"
+in this directory.
+
+---------------------------------------------------
+NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS 
+
+28Sep99	- Jing Guo
+	- Changed supported libraries to
+
+	mpeu:	libmpeu.a libeu.a with the _same_ interface in mpeu/
+
+	- Implemented several design changes:
+
+	  . Removed -r8/_R8_ compiler flags in Makefile.conf.IRIX64.
+	    The current design is expected to support both single and
+	    double precision REAL kinds.  The selection should be made
+	    by the compiler through Fortran 90 generic interface
+	    feature.
+
+	  . Added MP_type() function in mpif90.F90 to allow a more
+	    portable approach of using MPI_REAL.
+
+	  . Removed _SINGLE_PE_ flag to make the interface in mpeu/
+	    portable to both library versions.
+
+
+14Sep99	- Jing Guo	- Targets supported in this directory
+
+	mpeu:	make -f Makefile all		for MPI env
+	eu:	make -f Makefile.1pe all	for single PE env
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/assertmpeu.H
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/assertmpeu.H	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/assertmpeu.H	(revision 4775)
@@ -0,0 +1,55 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS assertmpeu.H,v 1.2 2007-08-17 20:44:17 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: assertmpeu.H - an #include section of ASSERT() macro for Fortran
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+!
+!	#define NDEBUG
+!	#include "assertmpeu.H"
+!	...
+!		use m_die,only : assert_
+!	...
+!		ASSERT( <Fortran expression> )
+!		ALWAYS_ASSERT( <Fortran expression> )
+!
+! !BUGS
+!	This macro requires Fortran friendly cpp() for macro processing.
+!
+! !REVISION HISTORY:
+!       17Aug07 - R. Jacob <jacob@mcs.anl.gov> - renamed from assert.H to 
+!                 prevent namespace collision with assert.h on Mac
+! 	28Aug00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- modified
+!		- added the prolog for a brief documentation
+!	before  - Tom Clune
+!		- Created for MP PSAS
+!EOP ___________________________________________________________________
+
+	! This implementation allows multi-"#include" in a single file
+
+#ifndef ALWAYS_ASSERT
+
+#define ALWAYS_ASSERT(EX) If (.not. (EX) ) call assert_("EX",__FILE__,__LINE__)
+#endif
+
+
+#ifndef ASSERT
+
+#ifdef NDEBUG
+
+#define ASSERT(EX) ! Skip assertion: EX
+
+#else
+
+#define ASSERT(EX) ALWAYS_ASSERT(EX)
+
+#endif
+
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/get_zeits.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/get_zeits.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/get_zeits.c	(revision 4775)
@@ -0,0 +1,76 @@
+/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS get_zeits.c,v 1.12 2012-01-31 19:42:07 jacob Exp
+! CVS MCT_2_8_0
+!-----------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: get_zeits - a C interface to times for Fortran calls
+!
+! !DESCRIPTION:
+!
+! !INTERFACE: */
+ /*
+  System times() dependencies:
+ */
+
+
+#include <sys/types.h>
+#ifndef NOTIMES 
+#include <sys/times.h>
+#endif
+
+#include <time.h> /* POSIX standard says CLOCKS_PER_SEC is here */
+#include "config.h"
+/*
+ *  CLK_TCK is obsolete - replace with CLOCKS_PER_SEC
+ */
+
+#define ZCLK_TCK ((double)CLOCKS_PER_SEC)
+
+
+
+
+ /*  Prototype: */
+
+   void FC_FUNC(get_zeits,GET_ZEITS)(double *zts);
+   void FC_FUNC(get_ztick,GET_ZTICK)(double *tic);
+
+/*!REVISION HISTORY:
+! 	12Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	06Jul99 - J.W. Larson <jlarson@dao> - support for AIX platform
+!EOP */
+
+/*  Implementations: */
+
+void FC_FUNC(get_zeits,GET_ZEITS)(zts)
+  double *zts;
+{
+
+#ifndef NOTIMES
+  struct tms tm;
+  double secs;
+  secs=1./ZCLK_TCK;
+
+  zts[0]=times(&tm)*secs;
+  zts[1]=tm.tms_utime*secs;
+  zts[2]=tm.tms_stime*secs;
+  zts[3]=tm.tms_cutime*secs;
+  zts[4]=tm.tms_cstime*secs;
+#else
+  zts[0]=0.;
+  zts[1]=0.;
+  zts[2]=0.;
+  zts[3]=0.;
+  zts[4]=0.;
+#endif
+
+}
+
+void FC_FUNC(get_ztick,GET_ZTICK)(tic)
+  double *tic;
+{
+  tic[0]=1./ZCLK_TCK;
+}
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FcComms.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FcComms.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FcComms.F90	(revision 4775)
@@ -0,0 +1,685 @@
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_FcComms - MPI collective communication operators
+!                      with explict flow control
+!
+! !DESCRIPTION:
+!
+! This module includes implementations of MPI collective operators that
+! have proven problematic on certain systems when run at scale. By 
+! introducing additonal flow control, these problems (exhausting internal
+! system resources) can be avoided. These routines were ported from
+! the Community Atmosphere Model's spmd_utils.F90.
+!
+! !INTERFACE:
+!
+! Workaround for performance issue with rsend on cray systems with
+! gemini interconnect
+!
+#ifdef _NO_MPI_RSEND
+#define MPI_RSEND MPI_SEND
+#define mpi_rsend mpi_send
+#define MPI_IRSEND MPI_ISEND
+#define mpi_irsend mpi_isend
+#endif
+
+ module m_FcComms
+
+      implicit none
+
+      private	! except
+
+      public :: fc_gather_int  ! flow control version of mpi_gather for integer vectors
+      public :: fc_gather_fp   ! flow control version of mpi_gather for FP vectors
+      public :: fc_gatherv_int ! flow control version of mpi_gatherv for integer vectors
+      public :: fc_gatherv_fp  ! flow control version of mpi_gatherv for integer vectors
+      public :: get_fcblocksize ! get current value of max_gather_block_size
+      public :: set_fcblocksize ! set current value of max_gather_block_size
+
+
+! !REVISION HISTORY:
+! 30Jan09 - P.H. Worley <worleyph@ornl.gov> - imported routines
+!           from CAM's spmd_utils to create this module.
+
+  integer, public :: max_gather_block_size = 64
+  character(len=*),parameter :: myname='MCT(MPEU)::m_FcComms'
+
+ contains
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: fc_gather_int - Gather an array of type integer
+!
+! !DESCRIPTION:
+! This routine gathers a {\em distributed} array of type {\em integer} 
+! to the {\tt root} process. Explicit handshaking messages are used
+! to control the number of processes communicating with the root
+! at any one time.
+!
+! If flow_cntl optional parameter 
+!    < 0 : use MPI_Gather
+!    >= 0: use point-to-point with handshaking messages and 
+!          preposting receive requests up to 
+!          min(max(1,flow_cntl),max_gather_block_size) 
+!          ahead if optional flow_cntl parameter is present.
+!          Otherwise, max_gather_block_size is used in its place.
+!    Default value is max_gather_block_size.
+! !INTERFACE:
+!
+   subroutine fc_gather_int (sendbuf, sendcnt, sendtype, &
+                             recvbuf, recvcnt, recvtype, &
+                             root, comm, flow_cntl )
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+!
+! !INPUT PARAMETERS: 
+!
+      integer, intent(in) :: sendbuf(*)
+      integer, intent(in) :: sendcnt
+      integer, intent(in) :: sendtype
+      integer, intent(in) :: recvcnt
+      integer, intent(in) :: recvtype
+      integer, intent(in) :: root
+      integer, intent(in) :: comm
+      integer, optional, intent(in) :: flow_cntl
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, intent(out) :: recvbuf(*)
+
+! !REVISION HISTORY:
+! 30Jan09 - P.H. Worley - imported from spmd_utils.F90
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::fc_gather_int'
+
+ integer :: signal
+ logical fc_gather         ! use explicit flow control?
+ integer gather_block_size ! number of preposted receive requests
+
+ integer :: mytid, mysize, mtag, p, i, count, displs
+ integer :: preposts, head, tail
+ integer :: rcvid(max_gather_block_size)
+ integer :: status(MP_STATUS_SIZE)
+ integer :: ier ! MPI error code
+
+ signal = 1
+ if ( present(flow_cntl) ) then
+    if (flow_cntl >= 0) then
+       gather_block_size = min(max(1,flow_cntl),max_gather_block_size)
+       fc_gather = .true.
+    else
+       fc_gather = .false.
+    endif
+ else
+    gather_block_size = max(1,max_gather_block_size)
+    fc_gather = .true.
+ endif
+
+ if (fc_gather) then
+ 
+    call mpi_comm_rank (comm, mytid, ier)
+    call mpi_comm_size (comm, mysize, ier)
+    mtag = 0
+    if (root .eq. mytid) then
+
+! prepost gather_block_size irecvs, and start receiving data
+       preposts = min(mysize-1, gather_block_size)
+       head = 0
+       count = 0
+       do p=0, mysize-1
+          if (p .ne. root) then
+             if (recvcnt > 0) then
+                count = count + 1
+                if (count > preposts) then
+                   tail = mod(head,preposts) + 1
+                   call mpi_wait (rcvid(tail), status, ier)
+                end if
+                head = mod(head,preposts) + 1
+                displs = p*recvcnt
+                call mpi_irecv ( recvbuf(displs+1), recvcnt, &
+                                 recvtype, p, mtag, comm, rcvid(head), &
+                                 ier )
+                call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier )
+             end if
+          end if
+       end do
+
+! copy local data
+       displs = mytid*recvcnt
+       do i=1,sendcnt
+          recvbuf(displs+i) = sendbuf(i)
+       enddo
+
+! wait for final data
+       do i=1,min(count,preposts)
+          call mpi_wait (rcvid(i), status, ier)
+       enddo
+
+    else
+
+       if (sendcnt > 0) then
+          call mpi_recv ( signal, 1, sendtype, root, mtag, comm, &
+                          status, ier )
+          call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, &
+                           comm, ier )
+       end if
+
+    endif
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: (point-to-point implementation)',ier)
+    end if
+
+ else
+ 
+    call mpi_gather (sendbuf, sendcnt, sendtype, &
+                     recvbuf, recvcnt, recvtype, &
+                     root, comm, ier)
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: MPI_GATHER',ier)
+    end if
+
+ endif
+
+ return
+ end subroutine fc_gather_int
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: fc_gather_fp - Gather an array of type FP
+!
+! !DESCRIPTION:
+! This routine gathers a {\em distributed} array of type {\em FP} to
+! the {\tt root} process. Explicit handshaking messages are used
+! to control the number of processes communicating with the root
+! at any one time.
+!
+! If flow_cntl optional parameter 
+!    < 0 : use MPI_Gather
+!    >= 0: use point-to-point with handshaking messages and 
+!          preposting receive requests up to 
+!          min(max(1,flow_cntl),max_gather_block_size) 
+!          ahead if optional flow_cntl parameter is present.
+!          Otherwise, max_gather_block_size is used in its place.
+!    Default value is max_gather_block_size.
+! !INTERFACE:
+!
+   subroutine fc_gather_fp (sendbuf, sendcnt, sendtype, &
+                            recvbuf, recvcnt, recvtype, &
+                             root, comm, flow_cntl )
+!
+! !USES:
+!
+      use m_realkinds, only : FP
+      use m_die
+      use m_mpif90
+!
+! !INPUT PARAMETERS: 
+!
+      real (FP), intent(in)  :: sendbuf(*)
+      integer, intent(in) :: sendcnt
+      integer, intent(in) :: sendtype
+      integer, intent(in) :: recvcnt
+      integer, intent(in) :: recvtype
+      integer, intent(in) :: root
+      integer, intent(in) :: comm
+      integer, optional, intent(in) :: flow_cntl
+
+! !OUTPUT PARAMETERS: 
+!
+      real (FP), intent(out) :: recvbuf(*)
+
+! !REVISION HISTORY:
+! 30Jan09 - P.H. Worley - imported from spmd_utils.F90
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::fc_gather_fp'
+
+ real (FP) :: signal
+ logical fc_gather         ! use explicit flow control?
+ integer gather_block_size ! number of preposted receive requests
+
+ integer :: mytid, mysize, mtag, p, i, count, displs
+ integer :: preposts, head, tail
+ integer :: rcvid(max_gather_block_size)
+ integer :: status(MP_STATUS_SIZE)
+ integer :: ier ! MPI error code
+
+ signal = 1.0
+ if ( present(flow_cntl) ) then
+    if (flow_cntl >= 0) then
+       gather_block_size = min(max(1,flow_cntl),max_gather_block_size)
+       fc_gather = .true.
+    else
+       fc_gather = .false.
+    endif
+ else
+    gather_block_size = max(1,max_gather_block_size)
+    fc_gather = .true.
+ endif
+
+ if (fc_gather) then
+ 
+    call mpi_comm_rank (comm, mytid, ier)
+    call mpi_comm_size (comm, mysize, ier)
+    mtag = 0
+    if (root .eq. mytid) then
+
+! prepost gather_block_size irecvs, and start receiving data
+       preposts = min(mysize-1, gather_block_size)
+       head = 0
+       count = 0
+       do p=0, mysize-1
+          if (p .ne. root) then
+             if (recvcnt > 0) then
+                count = count + 1
+                if (count > preposts) then
+                   tail = mod(head,preposts) + 1
+                   call mpi_wait (rcvid(tail), status, ier)
+                end if
+                head = mod(head,preposts) + 1
+                displs = p*recvcnt
+                call mpi_irecv ( recvbuf(displs+1), recvcnt, &
+                                 recvtype, p, mtag, comm, rcvid(head), &
+                                 ier )
+                call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier )
+             end if
+          end if
+       end do
+
+! copy local data
+       displs = mytid*recvcnt
+       do i=1,sendcnt
+          recvbuf(displs+i) = sendbuf(i)
+       enddo
+
+! wait for final data
+       do i=1,min(count,preposts)
+          call mpi_wait (rcvid(i), status, ier)
+       enddo
+
+    else
+
+       if (sendcnt > 0) then
+          call mpi_recv ( signal, 1, sendtype, root, mtag, comm, &
+                          status, ier )
+          call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, &
+                           comm, ier )
+       end if
+
+    endif
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: (point-to-point implementation)',ier)
+    end if
+
+ else
+ 
+    call mpi_gather (sendbuf, sendcnt, sendtype, &
+                     recvbuf, recvcnt, recvtype, &
+                      root, comm, ier)
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: MPI_GATHER',ier)
+    end if
+
+ endif
+
+ return
+ end subroutine fc_gather_fp
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: fc_gatherv_int - Gather an array of type integer
+!
+! !DESCRIPTION:
+! This routine gathers a {\em distributed} array of type {\em integer} 
+! to the {\tt root} process. Explicit handshaking messages are used
+! to control the number of processes communicating with the root
+! at any one time.
+!
+! If flow_cntl optional parameter 
+!    < 0 : use MPI_Gatherv
+!    >= 0: use point-to-point with handshaking messages and 
+!          preposting receive requests up to 
+!          min(max(1,flow_cntl),max_gather_block_size) 
+!          ahead if optional flow_cntl parameter is present.
+!          Otherwise, max_gather_block_size is used in its place.
+!    Default value is max_gather_block_size.
+! !INTERFACE:
+!
+   subroutine fc_gatherv_int (sendbuf, sendcnt, sendtype, &
+                              recvbuf, recvcnts, displs, recvtype, &
+                              root, comm, flow_cntl )
+!
+! !USES:
+!
+      use m_die
+      use m_mpif90
+!
+! !INPUT PARAMETERS: 
+!
+      integer, intent(in) :: sendbuf(*)
+      integer, intent(in) :: sendcnt
+      integer, intent(in) :: sendtype
+      integer, intent(in) :: recvcnts(*)
+      integer, intent(in) :: displs(*)
+      integer, intent(in) :: recvtype
+      integer, intent(in) :: root
+      integer, intent(in) :: comm
+      integer, optional, intent(in) :: flow_cntl
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, intent(out) :: recvbuf(*)
+
+! !REVISION HISTORY:
+! 30Jan09 - P.H. Worley - imported from spmd_utils.F90
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::fc_gatherv_int'
+
+ integer :: signal
+ logical fc_gather         ! use explicit flow control?
+ integer gather_block_size ! number of preposted receive requests
+
+ integer :: mytid, mysize, mtag, p, q, i, count
+ integer :: preposts, head, tail
+ integer :: rcvid(max_gather_block_size)
+ integer :: status(MP_STATUS_SIZE)
+ integer :: ier ! MPI error code
+
+ signal = 1
+ if ( present(flow_cntl) ) then
+    if (flow_cntl >= 0) then
+       gather_block_size = min(max(1,flow_cntl),max_gather_block_size)
+       fc_gather = .true.
+    else
+       fc_gather = .false.
+    endif
+ else
+    gather_block_size = max(1,max_gather_block_size)
+    fc_gather = .true.
+ endif
+
+ if (fc_gather) then
+ 
+    call mpi_comm_rank (comm, mytid, ier)
+    call mpi_comm_size (comm, mysize, ier)
+    mtag = 0
+    if (root .eq. mytid) then
+
+! prepost gather_block_size irecvs, and start receiving data
+       preposts = min(mysize-1, gather_block_size)
+       head = 0
+       count = 0
+       do p=0, mysize-1
+          if (p .ne. root) then
+             q = p+1
+             if (recvcnts(q) > 0) then
+                count = count + 1
+                if (count > preposts) then
+                   tail = mod(head,preposts) + 1
+                   call mpi_wait (rcvid(tail), status, ier)
+                end if
+                head = mod(head,preposts) + 1
+                call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), &
+                                 recvtype, p, mtag, comm, rcvid(head), &
+                                 ier )
+                call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier )
+             end if
+          end if
+       end do
+
+! copy local data
+       q = mytid+1
+       do i=1,sendcnt
+          recvbuf(displs(q)+i) = sendbuf(i)
+       enddo
+
+! wait for final data
+       do i=1,min(count,preposts)
+          call mpi_wait (rcvid(i), status, ier)
+       enddo
+
+    else
+
+       if (sendcnt > 0) then
+          call mpi_recv ( signal, 1, sendtype, root, mtag, comm, &
+                          status, ier )
+          call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, &
+                           comm, ier )
+       end if
+
+    endif
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: (point-to-point implementation)',ier)
+    end if
+
+ else
+ 
+    call mpi_gatherv (sendbuf, sendcnt, sendtype, &
+                      recvbuf, recvcnts, displs, recvtype, &
+                      root, comm, ier)
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: MPI_GATHERV',ier)
+    end if
+
+ endif
+
+ return
+ end subroutine fc_gatherv_int
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: fc_gatherv_fp - Gather an array of type FP
+!
+! !DESCRIPTION:
+! This routine gathers a {\em distributed} array of type {\em FP} to
+! the {\tt root} process. Explicit handshaking messages are used
+! to control the number of processes communicating with the root
+! at any one time.
+!
+! If flow_cntl optional parameter 
+!    < 0 : use MPI_Gatherv
+!    >= 0: use point-to-point with handshaking messages and 
+!          preposting receive requests up to 
+!          min(max(1,flow_cntl),max_gather_block_size) 
+!          ahead if optional flow_cntl parameter is present.
+!          Otherwise, max_gather_block_size is used in its place.
+!    Default value is max_gather_block_size.
+! !INTERFACE:
+!
+   subroutine fc_gatherv_fp (sendbuf, sendcnt, sendtype, &
+                             recvbuf, recvcnts, displs, recvtype, &
+                             root, comm, flow_cntl )
+!
+! !USES:
+!
+      use m_realkinds, only : FP
+      use m_die
+      use m_mpif90
+!
+! !INPUT PARAMETERS: 
+!
+      real (FP), intent(in)  :: sendbuf(*)
+      integer, intent(in) :: sendcnt
+      integer, intent(in) :: sendtype
+      integer, intent(in) :: recvcnts(*)
+      integer, intent(in) :: displs(*)
+      integer, intent(in) :: recvtype
+      integer, intent(in) :: root
+      integer, intent(in) :: comm
+      integer, optional, intent(in) :: flow_cntl
+
+! !OUTPUT PARAMETERS: 
+!
+      real (FP), intent(out) :: recvbuf(*)
+
+! !REVISION HISTORY:
+! 30Jan09 - P.H. Worley - imported from spmd_utils.F90
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::fc_gatherv_fp'
+
+ real (FP) :: signal
+ logical fc_gather         ! use explicit flow control?
+ integer gather_block_size ! number of preposted receive requests
+
+ integer :: mytid, mysize, mtag, p, q, i, count
+ integer :: preposts, head, tail
+ integer :: rcvid(max_gather_block_size)
+ integer :: status(MP_STATUS_SIZE)
+ integer :: ier ! MPI error code
+
+ signal = 1.0
+ if ( present(flow_cntl) ) then
+    if (flow_cntl >= 0) then
+       gather_block_size = min(max(1,flow_cntl),max_gather_block_size)
+       fc_gather = .true.
+    else
+       fc_gather = .false.
+    endif
+ else
+    gather_block_size = max(1,max_gather_block_size)
+    fc_gather = .true.
+ endif
+
+ if (fc_gather) then
+ 
+    call mpi_comm_rank (comm, mytid, ier)
+    call mpi_comm_size (comm, mysize, ier)
+    mtag = 0
+    if (root .eq. mytid) then
+
+! prepost gather_block_size irecvs, and start receiving data
+       preposts = min(mysize-1, gather_block_size)
+       head = 0
+       count = 0
+       do p=0, mysize-1
+          if (p .ne. root) then
+             q = p+1
+             if (recvcnts(q) > 0) then
+                count = count + 1
+                if (count > preposts) then
+                   tail = mod(head,preposts) + 1
+                   call mpi_wait (rcvid(tail), status, ier)
+                end if
+                head = mod(head,preposts) + 1
+                call mpi_irecv ( recvbuf(displs(q)+1), recvcnts(q), &
+                                 recvtype, p, mtag, comm, rcvid(head), &
+                                 ier )
+                call mpi_send ( signal, 1, recvtype, p, mtag, comm, ier )
+             end if
+          end if
+       end do
+
+! copy local data
+       q = mytid+1
+       do i=1,sendcnt
+          recvbuf(displs(q)+i) = sendbuf(i)
+       enddo
+
+! wait for final data
+       do i=1,min(count,preposts)
+          call mpi_wait (rcvid(i), status, ier)
+       enddo
+
+    else
+
+       if (sendcnt > 0) then
+          call mpi_recv ( signal, 1, sendtype, root, mtag, comm, &
+                          status, ier )
+          call mpi_rsend ( sendbuf, sendcnt, sendtype, root, mtag, &
+                           comm, ier )
+       end if
+
+    endif
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: (point-to-point implementation)',ier)
+    end if
+
+ else
+ 
+    call mpi_gatherv (sendbuf, sendcnt, sendtype, &
+                      recvbuf, recvcnts, displs, recvtype, &
+                      root, comm, ier)
+    if (ier /= 0) then
+       call MP_perr_die(myname_,':: MPI_GATHERV',ier)
+    end if
+
+ endif
+
+ return
+ end subroutine fc_gatherv_fp
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: get_fcblocksize - return max_gather_block_size
+!
+! !DESCRIPTION:
+! This function returns the current value of max_gather_block_size
+!
+! !INTERFACE:
+
+ function get_fcblocksize()
+
+! !USES:
+!
+! No external modules are used by this function.
+
+     implicit none
+
+! !INPUT PARAMETERS: 
+!
+
+! !OUTPUT PARAMETERS: 
+!
+    integer           :: get_fcblocksize
+
+! !REVISION HISTORY:
+!       03Mar09 - R. Jacob (jacob@mcs.anl.gov) -- intial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::get_fcblocksize'
+
+  get_fcblocksize = max_gather_block_size
+
+ end function  get_fcblocksize
+
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: set_fcblocksize - set max_gather_block_size
+!
+! !DESCRIPTION:
+! This function sets the current value of max_gather_block_size
+!
+! !INTERFACE:
+
+ subroutine set_fcblocksize(gather_block_size)
+
+! !USES:
+!
+! No external modules are used by this function.
+
+     implicit none
+
+! !INPUT PARAMETERS: 
+!
+    integer           :: gather_block_size
+
+! !OUTPUT PARAMETERS: 
+!
+
+! !REVISION HISTORY:
+!       03Mar09 - R. Jacob (jacob@mcs.anl.gov) -- intial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//':: set_fcblocksize'
+
+  max_gather_block_size = gather_block_size
+
+ end subroutine  set_fcblocksize
+
+ end module m_FcComms
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FileResolv.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FileResolv.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FileResolv.F90	(revision 4775)
@@ -0,0 +1,273 @@
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+! CVS m_FileResolv.F90,v 1.5 2012-04-30 01:02:53 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE:  m_FileResolv --- Resolve file name templates
+! 
+! !INTERFACE:
+!
+
+   MODULE  m_FileResolv
+
+! !USES:
+
+   use  m_StrTemplate  ! grads style templates
+   use  m_die
+   Implicit NONE
+
+!
+! !PUBLIC MEMBER FUNCTIONS:
+!
+   PRIVATE
+   PUBLIC  FileResolv
+   PUBLIC  remote_cp
+   PUBLIC  gunzip
+!
+! !DESCRIPTION: This module provides routines for resolving GrADS like
+!               file name templates. 
+!
+! !REVISION HISTORY: 
+!
+!  10Jan2000 da Silva  Initial code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+  character(len=255) :: remote_cp = 'rcp'
+  character(len=255) ::    gunzip = 'gunzip'
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: FileResolv -- Resolve file name templates (single file)
+! 
+! !INTERFACE:
+!
+    subroutine FileResolv ( expid, nymd, nhms, templ, fname, &
+                            stat, cache )  
+
+! !USES:
+
+    IMPLICIT NONE
+
+!
+! !INPUT PARAMETERS: 
+!
+    character(len=*), intent(in) :: expid          ! Experiment id
+    integer,          intent(in) :: nymd           ! Year-month-day
+    integer,          intent(in) :: nhms           ! Hour-min-sec
+    character(len=*), intent(in) :: templ       ! file name template
+
+!
+! !OUTPUT PARAMETERS: 
+!
+    character(len=*),  intent(out) :: fname        ! resolved file name
+
+    integer, OPTIONAL, intent(out) :: stat         ! Status
+                                                   !  0 - file exists
+                                                   !  1 - file does not exist
+
+    logical, OPTIONAL, intent(in) :: cache         ! skips rcp/gunzip if
+                                                   ! file exists locally
+
+! !DESCRIPTION: Resolve file name templates, rcp'ing files from remote and
+!               performing gunzip'ing as necessary.
+!
+! !TO DO:
+!         1. Expand environment variables in templates           
+!
+! !REVISION HISTORY: 
+!
+! 10Jan2000  da Silva  Initial code,
+! 23Jul2002  J. Larson <larson@mcs.anl.gov> - fixed bug detected by the
+!            Fujitsu frt compiler (on the VPP).
+!
+!EOP
+!--------------------------------------------------------------------------
+
+   character(len=*), parameter	:: myname = 'MCT(MPEU)::FileResolv'
+
+#if SYSUNICOS || CPRCRAY
+   integer, external  :: ishell
+#elif (!defined __GFORTRAN__)
+   integer, external  :: system
+#endif
+   character(len=255) :: path, host, dirn, basen, head, tail, cmd, filen
+
+   integer i, rc
+   logical :: fexists, caching
+
+
+!  Default is cache = .true.
+!  -------------------------
+   if ( present(cache) ) then
+        caching = cache
+   else
+        caching = .TRUE.
+   end if
+
+!  Start by expanding template
+!  ---------------------------
+   call strTemplate ( path, templ, 'GRADS', trim(expid), nymd, nhms, rc )
+   if ( rc .ne. 0 ) then
+        if ( present(stat) ) then 
+             stat = 1
+             return
+        else
+             call die ( myname, 'cannot expand template '//trim(templ) )
+        end if
+   end if
+
+
+!  Parse file name
+!  ---------------
+   i = index ( trim(path), ':' )
+   if ( i .gt. 0 ) then
+        host  = path(1:i-1)
+        fname = path(i+1:)
+   else
+        host = ''
+        fname = path
+   end if
+   i = index ( trim(fname), '/', back=.true. )
+   if ( i .gt. 1 ) then
+        dirn  = fname(1:i-1)
+        basen = fname(i+1:) 
+   else if ( i .gt. 0 ) then
+        dirn  = fname(1:i)
+        basen = fname(i+1:) 
+   else
+        dirn  = ''
+        basen = fname 
+   end if
+   i = index ( basen, '.', back=.true. )
+   if ( i .gt. 0 ) then
+      head = basen(1:i-1)
+      tail = basen(i+1:)
+   else
+      head = basen
+      tail = ''
+   end if
+
+!   print *, 'Template = |'//trim(templ)//'|'
+!   print *, '   path  = |'//trim(path)//'|'
+!   print *, '   host  = |'//trim(host)//'|'
+!   print *, '   dirn  = |'//trim(dirn)//'|'
+!   print *, '   basen = |'//trim(basen)//'|'
+!   print *, '   head  = |'//trim(head)//'|'
+!   print *, '   tail  = |'//trim(tail)//'|'
+!   print *, '   fname = |'//trim(fname)//'|'
+
+
+!  If file is remote, bring it here
+!  --------------------------------
+   if ( len_trim(host) .gt. 0 ) then
+      if ( trim(tail) .eq. 'gz' ) then
+           inquire ( file=trim(head),  exist=fexists ) 
+           filen = head
+      else
+           inquire ( file=trim(basen), exist=fexists )
+           filen = basen
+      end if
+      if ( .not. ( fexists .and. caching ) ) then
+         cmd = trim(remote_cp) // ' ' // &
+               trim(host) // ':' // trim(fname) // ' . '
+#if SYSUNICOS || CPRCRAY
+         rc = ishell ( cmd ) 
+#else
+         rc = system ( cmd ) 
+#endif
+
+         if ( rc .eq. 0 ) then
+            fname = basen
+         else
+            if ( present(stat) ) then ! return an error code
+               stat = 2
+               return
+	    else ! shut down
+               fname = basen
+               call die ( myname, 'cannot execute: '//trim(cmd) )
+            end if
+         end if
+       else 
+         fname = filen
+         call warn(myname,'using cached version of '//trim(filen) )
+       end if
+
+
+!  If not, make sure file exists locally
+!  -------------------------------------
+   else
+
+      inquire ( file=trim(fname), exist=fexists )
+      if ( .not. fexists ) then
+           if ( present(stat) ) then
+              stat = 3
+           else
+              call die(myname,'cannot find '//trim(fname) )
+           end if
+      end if
+ 
+   end if 
+
+
+!  If file is gzip'ed, leave original alone and create uncompressed
+!  version in the local directory
+!  ----------------------------------------------------------------
+   if ( trim(tail) .eq. 'gz' ) then
+      inquire ( file=trim(head), exist=fexists ) ! do we have a local copy?
+      if ( .not. ( fexists .and. caching ) ) then
+        if ( len_trim(host) .gt. 0 ) then             ! remove file.gz 
+             cmd = trim(gunzip) // ' -f ' // trim(fname) 
+        else                                          ! keep   file.gz
+             cmd = trim(gunzip) // ' -c ' // trim(fname) // ' > ' // trim(head)
+        end if
+#if SYSUNICOS || CPRCRAY
+        rc = ishell ( cmd ) 
+#else
+        rc = system ( cmd ) 
+#endif
+        if ( rc .eq. 0 ) then
+           fname = head             
+        else
+           if ( present(stat) ) then
+              stat = 4
+              return
+           else
+              call die ( myname, 'cannot execute: '//trim(cmd) )
+           end if
+        end if
+       else 
+         fname = head             
+         call warn(myname,'using cached version of '//trim(head) )
+       end if
+    end if
+
+
+!   Once more, make sure file exists
+!   --------------------------------
+    inquire ( file=trim(fname), exist=fexists )
+    if ( .not. fexists ) then
+       if ( present(stat) ) then
+          stat = 3
+       else
+          call die(myname,'cannot find '//trim(fname) )
+       end if
+    end if
+ 
+
+!   All done
+!   --------        
+    if ( present(stat) ) stat = 0
+
+  end subroutine FileResolv
+
+  end MODULE m_FileResolv
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Filename.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Filename.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Filename.F90	(revision 4775)
@@ -0,0 +1,106 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_Filename.F90,v 1.3 2004-04-21 22:54:44 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Filename - Filename manipulation routines
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_Filename
+      implicit none
+      private	! except
+
+      public :: Filename_base		! basename()
+      public :: Filename_dir		! dirname()
+
+      interface Filename_base; module procedure base_; end interface
+      interface Filename_dir;  module procedure dir_;  end interface
+
+! !REVISION HISTORY:
+! 	14Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_Filename'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: base_ - basename
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function base_(cstr,sfx)
+      implicit none
+      character(len=*)         ,intent(in) :: cstr
+      character(len=*),optional,intent(in) :: sfx
+      character(len=len(cstr)) :: base_
+
+! !REVISION HISTORY:
+! 	14Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::base_'
+  integer :: l,lb,le
+
+  l =index(cstr,'/',back=.true.)
+  lb=l+1		! correct either a '/' is in the string or not.
+  le=len_trim(cstr)
+
+  if(present(sfx)) then
+
+    l=le-len_trim(sfx)
+    if(sfx==cstr(l+1:le)) le=l
+
+  endif
+
+  base_=cstr(lb:le)
+
+end function base_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dir_ - dirname
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function dir_(cstr)
+      implicit none
+      character(len=*),intent(in) :: cstr
+      character(len=len(cstr)) :: dir_
+
+! !REVISION HISTORY:
+! 	14Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::dir_'
+  integer :: l
+
+  l =index(cstr,'/',back=.true.)
+  select case(l)
+  case(0)
+    dir_='.'
+  case(1)
+    dir_='/'
+  case default
+    dir_=cstr(1:l-1)
+  end select
+
+end function dir_
+
+end module m_Filename
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_char.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_char.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_char.F90	(revision 4775)
@@ -0,0 +1,257 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_IndexBin_char.F90,v 1.3 2004-04-21 22:54:44 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_IndexBin_char - Template of indexed bin-sorting module
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_IndexBin_char
+      implicit none
+      private	! except
+
+      public :: IndexBin
+      interface IndexBin; module procedure 	&
+	IndexBin0_,	&
+	IndexBin1_,	&
+	IndexBin1w_
+      end interface
+
+! !REVISION HISTORY:
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_IndexBin_char'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin0_ - Indexed sorting for a single value
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin0_(n,indx,keys,key0,ln0)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      character(len=*), dimension(n), intent(in) :: keys
+      character(len=*), intent(in) :: key0 ! value
+      integer,optional,intent(out) :: ln0
+
+! !REVISION HISTORY:
+! 	16Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!	27Sep99 - Jing Guo <guo@thunder> - Fixed a bug pointed out by
+!					   Chris Redder
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin0_'
+  integer,allocatable,dimension(:) :: inew
+  integer :: ni,ix,i,ier
+  integer :: ln(0:1),lc(0:1)
+!________________________________________
+
+	allocate(inew(n),stat=ier)
+		if(ier /= 0) then
+		  write(stderr,'(2a,i4)') myname_,	&
+			': allocate() error, stat =',ier
+		  call die(myname_)
+		endif
+!________________________________________
+		! Count numbers entries for the given key0
+	
+  lc(0)=1	! the location of values the same as key0
+  ln(0)=0
+  do i=1,n
+    if(keys(i) == key0) ln(0)=ln(0)+1
+  end do
+
+  lc(1)=ln(0)+1	! the location of values not the same as key0
+!________________________________________
+		! Reset the counters
+  ln(0:1)=0
+  do i=1,n
+    ix=indx(i)
+    if(keys(ix) == key0) then
+      ni=lc(0)+ln(0)
+      ln(0)=ln(0)+1
+      
+    else
+      ni=lc(1)+ln(1)
+      ln(1)=ln(1)+1
+    endif
+
+    inew(ni)=ix
+  end do
+
+!________________________________________
+		! Sort out the old pointers according to the new order
+  indx(:)=inew(:)
+  if(present(ln0)) ln0=ln(0)
+!________________________________________
+
+	  deallocate(inew)
+
+end subroutine IndexBin0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin1_ - Indexed sorting into a set of given bins
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin1_(n,indx,keys,bins,lcs,lns)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, intent(in) :: n
+      integer, dimension(n),intent(inout) :: indx
+      character(len=*),dimension(n),intent(in) :: keys
+      character(len=*),dimension(:),intent(in) :: bins ! values
+      integer, dimension(:),intent(out)   :: lcs ! locs. of the bins
+      integer, dimension(:),intent(out)   :: lns ! sizes of the bins
+
+! !REVISION HISTORY:
+! 	16Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin1_'
+  integer,allocatable,dimension(:) :: ibin,inew
+  integer :: nbin,lc0,ln0
+  integer :: ni,ix,ib,i,ier
+!________________________________________
+
+  nbin=size(bins)
+  if(nbin==0) return
+!________________________________________
+
+	allocate(ibin(n),inew(n),stat=ier)
+		if(ier /= 0) then
+		  write(stderr,'(2a,i4)') myname_,	&
+			': allocate() error, stat =',ier
+		  call die(myname_)
+		endif
+!________________________________________
+
+  do ib=1,nbin
+    lns(ib)=0
+    lcs(ib)=0
+  end do
+!________________________________________
+		! Count numbers in every bin, and store the bin-ID for
+		! later use.
+  do i=1,n
+    ix=indx(i)
+
+    call search_(keys(ix),nbin,bins,ib)	! ib = 1:nbin; =0 if not found
+
+    ibin(i)=ib
+    if(ib /= 0) lns(ib)=lns(ib)+1
+  end do
+!________________________________________
+		! Count the locations of every bin.
+  lc0=1
+  do ib=1,nbin
+    lcs(ib)=lc0
+    lc0=lc0+lns(ib)
+  end do
+!________________________________________
+		! Reset the counters
+  ln0=0
+  lns(1:nbin)=0
+  do i=1,n
+    ib=ibin(i)	! the bin-index of keys(indx(i))
+    if(ib/=0) then
+      ni=lcs(ib)+lns(ib)
+      lns(ib)=lns(ib)+1
+    else
+      ni=lc0+ln0
+      ln0=ln0+1
+    endif
+    inew(ni)=indx(i)	! the current value is put in the new order
+  end do
+!________________________________________
+		! Sort out the old pointers according to the new order
+  indx(:)=inew(:)
+!________________________________________
+
+	  deallocate(ibin,inew)
+
+contains
+subroutine search_(key,nbin,bins,ib)
+  implicit none
+  character(len=*), intent(in) :: key
+  integer,intent(in) :: nbin
+  character(len=*), intent(in),dimension(:) :: bins
+  integer,intent(out) :: ib
+  integer :: i
+
+  ib=0
+  do i=1,nbin
+    if(key==bins(i)) then
+      ib=i
+      return
+    endif
+  end do
+end subroutine search_
+
+end subroutine IndexBin1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin1w_ - IndexBin1_ wrapped without working arrays
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin1w_(n,indx,keys,bins)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer,             intent(in)    :: n
+      integer,dimension(n),intent(inout) :: indx
+      character(len=*),dimension(n),intent(in)    :: keys
+      character(len=*),dimension(:),intent(in)    :: bins ! values
+
+! !REVISION HISTORY:
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin1w_'
+  integer :: ier
+  integer,dimension(:),allocatable :: lcs,lns
+  integer :: nbin
+
+  nbin=size(bins)
+  if(nbin==0) return
+
+  allocate(lcs(nbin),lns(nbin),stat=ier)
+  if(ier /= 0) then
+    write(stderr,'(2a,i4)') myname_,': allocate() error, stat =',ier
+    call die(myname_)
+  endif
+
+  call IndexBin1_(n,indx,keys,bins,lcs,lns)
+
+  deallocate(lcs,lns)
+end subroutine IndexBin1w_
+end module m_IndexBin_char
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_integer.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_integer.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_integer.F90	(revision 4775)
@@ -0,0 +1,257 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_IndexBin_integer.F90,v 1.3 2004-04-21 22:54:45 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_IndexBin_integer - Template of indexed bin-sorting module
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_IndexBin_integer
+      implicit none
+      private	! except
+
+      public :: IndexBin
+      interface IndexBin; module procedure 	&
+	IndexBin0_,	&
+	IndexBin1_,	&
+	IndexBin1w_
+      end interface
+
+! !REVISION HISTORY:
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_IndexBin_integer'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin0_ - Indexed sorting for a single value
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin0_(n,indx,keys,key0,ln0)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      integer, dimension(n), intent(in) :: keys
+      integer, intent(in) :: key0 ! The key value to be moved to front
+      integer,optional,intent(out) :: ln0
+
+! !REVISION HISTORY:
+! 	16Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!	27Sep99 - Jing Guo <guo@thunder> - Fixed a bug pointed out by
+!					   Chris Redder
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin0_'
+  integer,allocatable,dimension(:) :: inew
+  integer :: ni,ix,i,ier
+  integer :: ln(0:1),lc(0:1)
+!________________________________________
+
+	allocate(inew(n),stat=ier)
+		if(ier /= 0) then
+		  write(stderr,'(2a,i4)') myname_,	&
+			': allocate() error, stat =',ier
+		  call die(myname_)
+		endif
+!________________________________________
+		! Count numbers entries for the given key0
+	
+  lc(0)=1	! the location of values the same as key0
+  ln(0)=0
+  do i=1,n
+    if(keys(i) == key0) ln(0)=ln(0)+1
+  end do
+
+  lc(1)=ln(0)+1	! the location of values not the same as key0
+!________________________________________
+		! Reset the counters
+  ln(0:1)=0
+  do i=1,n
+    ix=indx(i)
+    if(keys(ix) == key0) then
+      ni=lc(0)+ln(0)
+      ln(0)=ln(0)+1
+      
+    else
+      ni=lc(1)+ln(1)
+      ln(1)=ln(1)+1
+    endif
+
+    inew(ni)=ix
+  end do
+
+!________________________________________
+		! Sort out the old pointers according to the new order
+  indx(:)=inew(:)
+  if(present(ln0)) ln0=ln(0)
+!________________________________________
+
+	  deallocate(inew)
+
+end subroutine IndexBin0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin1_ - Indexed sorting into a set of given bins
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin1_(n,indx,keys,bins,lcs,lns)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, intent(in) :: n
+      integer, dimension(n),intent(inout) :: indx
+      integer, dimension(n),intent(in)    :: keys
+      integer, dimension(:),intent(in)    :: bins! values of the bins
+      integer, dimension(:),intent(out)   :: lcs ! locs. of the bins
+      integer, dimension(:),intent(out)   :: lns ! sizes of the bins
+
+! !REVISION HISTORY:
+! 	16Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin1_'
+  integer,allocatable,dimension(:) :: ibin,inew
+  integer :: nbin,lc0,ln0
+  integer :: ni,ix,ib,i,ier
+!________________________________________
+
+  nbin=size(bins)
+  if(nbin==0) return
+!________________________________________
+
+	allocate(ibin(n),inew(n),stat=ier)
+		if(ier /= 0) then
+		  write(stderr,'(2a,i4)') myname_,	&
+			': allocate() error, stat =',ier
+		  call die(myname_)
+		endif
+!________________________________________
+
+  do ib=1,nbin
+    lns(ib)=0
+    lcs(ib)=0
+  end do
+!________________________________________
+		! Count numbers in every bin, and store the bin-ID for
+		! later use.
+  do i=1,n
+    ix=indx(i)
+
+    call search_(keys(ix),nbin,bins,ib)	! ib = 1:nbin; =0 if not found
+
+    ibin(i)=ib
+    if(ib /= 0) lns(ib)=lns(ib)+1
+  end do
+!________________________________________
+		! Count the locations of every bin.
+  lc0=1
+  do ib=1,nbin
+    lcs(ib)=lc0
+    lc0=lc0+lns(ib)
+  end do
+!________________________________________
+		! Reset the counters
+  ln0=0
+  lns(1:nbin)=0
+  do i=1,n
+    ib=ibin(i)	! the bin-index of keys(indx(i))
+    if(ib/=0) then
+      ni=lcs(ib)+lns(ib)
+      lns(ib)=lns(ib)+1
+    else
+      ni=lc0+ln0
+      ln0=ln0+1
+    endif
+    inew(ni)=indx(i)	! the current value is put in the new order
+  end do
+!________________________________________
+		! Sort out the old pointers according to the new order
+  indx(:)=inew(:)
+!________________________________________
+
+	  deallocate(ibin,inew)
+
+contains
+subroutine search_(key,nbin,bins,ib)
+  implicit none
+  integer, intent(in) :: key
+  integer,intent(in) :: nbin
+  integer, intent(in),dimension(:) :: bins
+  integer,intent(out) :: ib
+  integer :: i
+
+  ib=0
+  do i=1,nbin
+    if(key==bins(i)) then
+      ib=i
+      return
+    endif
+  end do
+end subroutine search_
+
+end subroutine IndexBin1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin1w_ - IndexBin1_ wrapped without working arrays
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin1w_(n,indx,keys,bins)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer,             intent(in)    :: n
+      integer,dimension(n),intent(inout) :: indx
+      integer,dimension(n),intent(in)    :: keys
+      integer,dimension(:),intent(in)    :: bins ! values of the bins
+
+! !REVISION HISTORY:
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin1w_'
+  integer :: ier
+  integer,dimension(:),allocatable :: lcs,lns
+  integer :: nbin
+
+  nbin=size(bins)
+  if(nbin==0) return
+
+  allocate(lcs(nbin),lns(nbin),stat=ier)
+  if(ier /= 0) then
+    write(stderr,'(2a,i4)') myname_,': allocate() error, stat =',ier
+    call die(myname_)
+  endif
+
+  call IndexBin1_(n,indx,keys,bins,lcs,lns)
+
+  deallocate(lcs,lns)
+end subroutine IndexBin1w_
+end module m_IndexBin_integer
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_logical.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_logical.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_IndexBin_logical.F90	(revision 4775)
@@ -0,0 +1,105 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_IndexBin_logical.F90,v 1.3 2004-04-21 22:54:45 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_IndexBin_logical - Template of indexed bin-sorting module
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_IndexBin_logical
+      implicit none
+      private	! except
+
+      public :: IndexBin
+      interface IndexBin; module procedure 	&
+	IndexBin0_
+      end interface
+
+! !REVISION HISTORY:
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_IndexBin_logical'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: IndexBin0_ - Indexed sorting for a single value
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine IndexBin0_(n,indx,keys,key0,ln0)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      logical, dimension(n), intent(in) :: keys
+      logical, intent(in) :: key0 ! The key value to be moved to front
+      integer,optional,intent(out) :: ln0
+
+! !REVISION HISTORY:
+! 	16Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!	27Sep99 - Jing Guo <guo@thunder> - Fixed a bug pointed out by
+!					   Chris Redder
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::IndexBin0_'
+  integer,allocatable,dimension(:) :: inew
+  integer :: ni,ix,i,ier
+  integer :: ln(0:1),lc(0:1)
+!________________________________________
+
+	allocate(inew(n),stat=ier)
+		if(ier /= 0) then
+		  write(stderr,'(2a,i4)') myname_,	&
+			': allocate() error, stat =',ier
+		  call die(myname_)
+		endif
+!________________________________________
+		! Count numbers entries for the given key0
+	
+  lc(0)=1	! the location of values the same as key0
+  ln(0)=0
+  do i=1,n
+    if(keys(i) .eqv. key0) ln(0)=ln(0)+1
+  end do
+
+  lc(1)=ln(0)+1	! the location of values not the same as key0
+!________________________________________
+		! Reset the counters
+  ln(0:1)=0
+  do i=1,n
+    ix=indx(i)
+    if(keys(ix) .eqv. key0) then
+      ni=lc(0)+ln(0)
+      ln(0)=ln(0)+1
+      
+    else
+      ni=lc(1)+ln(1)
+      ln(1)=ln(1)+1
+    endif
+
+    inew(ni)=ix
+  end do
+
+!________________________________________
+		! Sort out the old pointers according to the new order
+  indx(:)=inew(:)
+  if(present(ln0)) ln0=ln(0)
+!________________________________________
+
+	  deallocate(inew)
+
+end subroutine IndexBin0_
+end module m_IndexBin_logical
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_List.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_List.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_List.F90	(revision 4775)
@@ -0,0 +1,2112 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_List.F90,v 1.36 2007-11-06 00:03:31 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_List - A List Manager
+!
+! !DESCRIPTION:  A {\em List} is a character buffer comprising 
+! substrings called {\em items} separated by colons, combined with 
+! indexing information describing (1) the starting point in the character 
+! buffer of each substring, and  (2) the length of each substring.  The 
+! only constraints on the valid list items are (1) the value of an 
+! item does not contain the ``\verb":"'' delimitter, and (2) leading 
+! and trailing blanks are stripped from any character string presented 
+! to define a list item (although any imbeded blanks are retained).
+!
+! {\bf Example:}  Suppose we wish to define a List containing the 
+! items {\tt 'latitude'}, {\tt 'longitude'}, and {\tt 'pressure'}.
+! The character buffer of the List containing these items will be the 
+! 27-character string
+! \begin{verbatim}
+! 'latitude:longitude:pressure'
+! \end{verbatim}
+! and the indexing information is summarized in the table below.
+!
+!\begin{table}[htbp]
+!\begin{center}
+!\begin{tabular}{|c|c|c|}
+!\hline
+!{\bf Item} & {\bf Starting Point in Buffer} & {\bf Length} \\
+!\hline
+!{\tt latitude} & 1 & 8 \\
+!\hline
+!{\tt longitude} & 9 & 9 \\
+!\hline
+!{\tt pressure} & 20 & 8\\
+!\hline
+!\end{tabular}
+!\end{center}
+!\end{table}
+!
+! One final note:  All operations for the {\tt List} datatype are 
+! {\bf case sensitive}. 
+!
+! !INTERFACE:
+
+ module m_List
+
+! !USES:
+!
+! No other Fortran modules are used.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: List		! The class data structure
+
+      Type List
+#ifdef SEQUENCE
+     sequence
+#endif
+	 character(len=1),dimension(:),pointer :: bf
+	 integer,       dimension(:,:),pointer :: lc
+      End Type List
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: init
+      public :: clean
+      public :: nullify
+      public :: index
+      public :: get_indices
+      public :: test_indices
+      public :: nitem
+      public :: get
+      public :: identical
+      public :: assignment(=)
+      public :: allocated
+      public :: copy
+      public :: exportToChar
+      public :: exportToString
+      public :: CharBufferSize
+      public :: append
+      public :: concatenate
+      public :: bcast
+      public :: send
+      public :: recv
+      public :: GetSharedListIndices
+
+  interface init ; module procedure	&
+      init_,		&
+      initStr_,	&
+      initstr1_
+  end interface
+  interface clean; module procedure clean_; end interface
+  interface nullify; module procedure nullify_; end interface
+  interface index; module procedure	&
+      index_,     &
+      indexStr_
+  end interface
+  interface get_indices; module procedure get_indices_; end interface
+  interface test_indices; module procedure test_indices_; end interface
+  interface nitem; module procedure nitem_; end interface
+  interface get  ; module procedure	&
+      get_,		&
+      getall_,	&
+      getrange_
+  end interface
+  interface identical; module procedure identical_; end interface
+  interface assignment(=)
+    module procedure copy_
+  end interface
+  interface allocated ; module procedure &
+       allocated_
+  end interface
+  interface copy ; module procedure copy_ ;  end interface
+  interface exportToChar ; module procedure &
+       exportToChar_
+  end interface
+  interface exportToString ; module procedure &
+       exportToString_
+  end interface
+  interface CharBufferSize ; module procedure &
+      CharBufferSize_
+  end interface
+  interface append ; module procedure append_ ; end interface
+  interface concatenate ; module procedure concatenate_ ; end interface
+  interface bcast; module procedure bcast_; end interface
+  interface send; module procedure send_; end interface
+  interface recv; module procedure recv_; end interface
+  interface GetSharedListIndices; module procedure &
+      GetSharedListIndices_ 
+  end interface
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 16May01 - J. Larson <larson@mcs.anl.gov> - Several changes / fixes:
+!           public interface for copy_(), corrected version of copy_(),
+!           corrected version of bcast_().
+! 15Oct01 - J. Larson <larson@mcs.anl.gov> - Added the LOGICAL 
+!           function identical_().
+! 14Dec01 - J. Larson <larson@mcs.anl.gov> - Added the LOGICAL 
+!           function allocated_().
+! 13Feb02 - J. Larson <larson@mcs.anl.gov> - Added the List query 
+!           functions exportToChar() and CharBufferLength().
+! 13Jun02-  R.L. Jacob <jacob@mcs.anl.gov> - Move GetSharedListIndices
+!           from mct to this module.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_List'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - Initialize a List from a CHARACTER String
+!
+! !DESCRIPTION:
+!
+! A list is a string in the form of ``\verb"Larry:Moe:Curly"'',
+! or ``\verb"lat:lon:lev"'', combined with substring location and 
+! length information.  Through the initialization call, the
+! items delimited by ``\verb":"'' are stored as an array of sub-
+! strings of a long string, accessible through an array of substring
+! indices.  The only constraints now on the valid list entries are,
+! (1) the value of an entry does not contain ``\verb":"'', and (2)
+! The leading and the trailing blanks are insignificant, although
+! any imbeded blanks are.  For example,
+!
+! \begin{verbatim} 
+! call init_(aList, 'batman  :SUPERMAN:Green Lantern:  Aquaman')
+! \end{verbatim} 
+! will result in {\tt aList} having four items:  'batman', 'SUPERMAN', 
+! 'Green Lantern', and 'Aquaman'.  That is
+! \begin{verbatim} 
+! aList%bf =  'batman:SUPERMAN:Green Lantern:Aquaman'
+! \end{verbatim} 
+!
+! !INTERFACE:
+
+ subroutine init_(aList,Values)
+
+! !USES:
+!
+      use m_die,only : die
+      use m_mall,only : mall_mci,mall_ison
+ 
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*),intent(in) :: Values ! ":" delimited names
+
+! !OUTPUT PARAMETERS:   
+!
+      type(List),intent(out)	  :: aList  ! an indexed string values
+ 
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::init_'
+  character(len=1) :: c
+  integer :: ib,ie,id,lb,le,ni,i,ier
+
+	! Pass 1, getting the sizes
+  le=0
+  ni=0
+  ib=1
+  ie=0
+  id=0
+  do i=1,len(Values)
+    c=Values(i:i)
+    select case(c)
+    case(' ')
+      if(ib==i) ib=i+1	! moving ib up, starting from the next
+    case(':')
+      if(ib<=ie) then
+	ni=ni+1
+	id=1		! mark a ':'
+      endif
+      ib=i+1		! moving ib up, starting from the next
+    case default
+      ie=i
+      if(id==1) then	! count an earlier marked ':'
+	id=0
+	le=le+1
+      endif
+      le=le+1
+    end select
+  end do
+  if(ib<=ie) ni=ni+1
+
+  ! COMPILER MAY NOT SIGNAL AN ERROR IF 
+  ! ALIST HAS ALREADY BEEN INITIALIZED.
+  ! PLEASE CHECK FOR PREVIOUS INITIALIZATION
+  
+  allocate(aList%bf(le),aList%lc(0:1,ni),stat=ier)
+  if(ier /= 0) call die(myname_,'allocate()',ier)
+
+	if(mall_ison()) then
+	  call mall_mci(aList%bf,myname)
+	  call mall_mci(aList%lc,myname)
+	endif
+
+	! Pass 2, copy the value and assign the pointers
+  lb=1
+  le=0
+  ni=0
+  ib=1
+  ie=0
+  id=0
+  do i=1,len(Values)
+    c=Values(i:i)
+
+    select case(c)
+    case(' ')
+      if(ib==i) ib=i+1	! moving ib up, starting from the next
+    case(':')
+      if(ib<=ie) then
+	ni=ni+1
+	aList%lc(0:1,ni)=(/lb,le/)
+	id=1		! mark a ':'
+      endif
+
+      ib=i+1		! moving ib up, starting from the next
+      lb=le+2		! skip to the next non-':' and non-','
+    case default
+      ie=i
+      if(id==1) then	! copy an earlier marked ':'
+	id=0
+	le=le+1
+        aList%bf(le)=':'
+      endif
+
+      le=le+1
+      aList%bf(le)=c
+    end select
+  end do
+  if(ib<=ie) then
+    ni=ni+1
+    aList%lc(0:1,ni)=(/lb,le/)
+  endif
+
+ end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initStr_ - Initialize a List Using the String Type
+!
+! !DESCRIPTION: This routine initializes a {\tt List} datatype given 
+! an input {\tt String} datatype (see {\tt m\_String} for more 
+! information regarding the {\tt String} type).  The contents of the 
+! input {\tt String} argument {\tt pstr} must adhere to the restrictions
+! stated for character input stated in the prologue of the routine 
+! {\tt init\_()} in this module.
+!
+! !INTERFACE:
+
+ subroutine initStr_(aList, pstr)
+
+! !USES:
+!
+      use m_String, only : String,toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),intent(in)	  :: pstr
+
+! !OUTPUT PARAMETERS:   
+!
+      type(List),intent(out)	  :: aList  ! an indexed string values
+
+
+! !REVISION HISTORY:
+! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initStr_'
+
+  call init_(aList,toChar(pstr))
+
+ end subroutine initStr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initStr1_ - Initialize a List Using an Array of Strings
+!
+! !DESCRIPTION: This routine initializes a {\tt List} datatype given 
+! as input array of {\tt String} datatypes (see {\tt m\_String} for more 
+! information regarding the {\tt String} type).  The contents of each 
+! {\tt String} element of the input array {\tt strs} must adhere to the 
+! restrictions stated for character input stated in the prologue of the 
+! routine {\tt init\_()} in this module.  Specifically, no element in 
+! {\tt strs} may contain the colon \verb':' delimiter, and any 
+! leading or trailing blanks will be stripped (though embedded blank
+! spaces will be retained).  For example, consider an invocation of 
+! {\tt initStr1\_()} where the array {\tt strs(:)} contains four entries:
+! {\tt strs(1)='John'}, {\tt strs(2)=' Paul'}, 
+! {\tt strs(3)='George '}, and {\tt strs(4)='  Ringo'}.  The resulting
+! {\tt List} output {\tt aList} will have
+! \begin{verbatim} 
+! aList%bf =  'John:Paul:George:Ringo'
+! \end{verbatim} 
+! !INTERFACE:
+
+ subroutine initStr1_(aList, strs)
+
+! !USES:
+!
+      use m_String, only : String,toChar
+      use m_String, only : len
+      use m_String, only : ptr_chars
+      use m_die,only : die
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),dimension(:),intent(in)	  :: strs
+
+! !OUTPUT PARAMETERS:   
+!
+      type(List),intent(out)	  :: aList  ! an indexed string values
+
+
+! !REVISION HISTORY:
+! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initStr1_'
+  character(len=1),allocatable,dimension(:) :: ch1
+  integer :: ier
+  integer :: n,i,lc,le
+
+  n=size(strs)
+  le=0
+  do i=1,n
+    le=le+len(strs(i))
+  end do
+  le=le+n-1	! for n-1 ":"s
+
+	allocate(ch1(le),stat=ier)
+		if(ier/=0) call die(myname_,'allocate()',ier)
+
+  le=0
+  do i=1,n
+    if(i>1) then
+      le=le+1
+      ch1(le)=':'
+    endif
+
+    lc=le+1
+    le=le+len(strs(i))
+    ch1(lc:le)=ptr_chars(strs(i))
+  end do
+    
+  call init_(aList,toChar(ch1))
+
+	deallocate(ch1,stat=ier)
+		if(ier/=0) call die(myname_,'deallocate()',ier)
+
+ end subroutine initStr1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Deallocate Memory Used by a List
+!
+! !DESCRIPTION:  This routine deallocates the allocated memory components
+! of the input/output {\tt List} argument {\tt aList}.  Specifically, it
+! deallocates {\tt aList\%bf} and {\tt aList\%lc}.  If the optional 
+! output {\tt INTEGER} arguemnt {\tt stat} is supplied, no warning will
+! be printed if the Fortran intrinsic {\tt deallocate()} returns with an
+! error condition.
+!
+! !INTERFACE:
+
+ subroutine clean_(aList, stat)
+
+! !USES:
+!
+      use m_die,  only : warn
+      use m_mall, only : mall_mco,mall_ison
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(List),        intent(inout) :: aList
+
+! !OUTPUT PARAMETERS:   
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> - added stat argument and
+!           removed die to prevent crashes.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+  if(mall_ison()) then
+     if(associated(aList%bf)) call mall_mco(aList%bf,myname_)
+     if(associated(aList%lc)) call mall_mco(aList%lc,myname_)
+  endif
+
+  if(associated(aList%bf) .and. associated(aList%lc)) then
+
+     deallocate(aList%bf, aList%lc, stat=ier)
+
+     if(present(stat)) then
+	stat=ier
+     else
+	if(ier /= 0) call warn(myname_,'deallocate(aList%...)',ier)
+     endif
+
+  endif
+
+ end subroutine clean_
+
+!--- -------------------------------------------------------------------
+!     Math + Computer Science Division / Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nullify_ - Nullify Pointers in a List
+!
+! !DESCRIPTION:  In Fortran 90, pointers may have three states:  
+! (1) {\tt ASSOCIATED}, that is the pointer is pointing at a target, 
+! (2) {\tt UNASSOCIATED}, and (3) {\tt UNINITIALIZED}.  On some 
+! platforms, the Fortran intrinsic function {\tt associated()} 
+! will view uninitialized pointers as {\tt UNASSOCIATED} by default.
+! This is not always the case.  It is good programming practice to 
+! nullify pointers if they are not to be used.  This routine nullifies
+! the pointers present in the {\tt List} datatype.
+!
+! !INTERFACE:
+
+ subroutine nullify_(aList)
+
+! !USES:
+!
+      use m_die,only : die
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(List),intent(inout) :: aList
+
+! !REVISION HISTORY:
+! 18Jun01 - J.W. Larson - <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nullify_'
+
+  nullify(aList%bf)
+  nullify(aList%lc)
+
+ end subroutine nullify_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: nitem_ - Return the Number of Items in a List
+!
+! !DESCRIPTION:  
+! This function enumerates the number of items in the input {\tt List} 
+! argument {\tt aList}.  For example, suppose 
+! \begin{verbatim}
+!  aList%bf = 'John:Paul:George:Ringo'
+! \end{verbatim}
+!  Then, 
+! $${\tt nitem\_(aList)} = 4 .$$
+!
+! !INTERFACE:
+
+ integer function nitem_(aList)
+
+! !USES:
+!
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),intent(in) :: aList
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 10Oct01 - J.W. Larson <larson@mcs.anl.gov> - modified routine to
+!           check pointers aList%bf and aList%lc using  the f90 
+!           intrinsic ASSOCIATED before proceeding with the item
+!           count.  If these pointers are UNASSOCIATED, an item
+!           count of zero is returned.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::nitem_'
+  integer :: NumItems
+
+       ! Initialize item count to zero
+
+  NumItems = 0
+
+       ! If the List pointers are ASSOCIATED, perform item count:
+
+  if(ASSOCIATED(aList%bf) .and. ASSOCIATED(aList%lc)) then
+     NumItems = size(aList%lc,2)
+  endif
+
+  nitem_ = NumItems
+
+ end function nitem_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: index_ - Return Rank in a List of a Given Item (CHARACTER)
+!
+! !DESCRIPTION:
+! This function returns the rank of an item (defined by the 
+! {\tt CHARACTER} argument {\tt item}) in the input {\tt List} argument
+! {\tt aList}.  If {\tt item} is not present in {\tt aList}, then zero 
+! is returned.  For example, suppose 
+! \begin{verbatim}
+!  aList%bf = 'Bob:Carol:Ted:Alice'
+! \end{verbatim}
+!  Then, ${\tt index\_(aList, 'Ted')}=3$, ${\tt index\_(aList, 'Carol')}=2$,
+! and ${\tt index\_(aList, 'The Dude')}=0.$
+!
+! !INTERFACE:
+
+ integer function index_(aList, item)
+
+! !USES:
+!
+      use m_String, only : toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),      intent(in) :: aList	! a List of names
+      character(len=*),intent(in) :: item	! a given item name
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::index_'
+  integer :: i,lb,le
+  integer :: itemLength, length, nMatch, j
+
+       ! How long is the input item name?
+
+  itemLength = len(item)
+
+       ! Set output to zero (no item match) value:
+
+  index_=0
+
+       ! Now, go through the aList one item at a time
+
+  ITEM_COMPARE: do i=1,size(aList%lc,2)		! == nitem_(aList)
+
+       ! Compute some stats for the current item in aList:
+
+    lb=aList%lc(0,i) ! starting index of item in aList%bf
+    le=aList%lc(1,i) ! ending index item in aList%bf
+
+    length = le -lb + 1 ! length of the current item
+    if(length /= itemLength) then ! this list item can't match input item
+
+       CYCLE ! that is, jump to the next item in aList...
+
+    else ! compare one character at a time...
+
+       ! Initialize number of matching characters in the two strings
+
+       nMatch = 0 
+
+       ! Now, compare item to the current item in aList one character 
+       ! at a time:
+
+       CHAR_COMPARE: do j=1,length
+	  if(aList%bf(lb+j-1) == item(j:j)) then ! a match for this character
+	     nMatch = nMatch + 1
+	  else
+	     EXIT
+	  endif
+       end do CHAR_COMPARE
+
+       ! Check the number of leading characters in the current item in aList
+       ! that match the input item.  If it is equal to the item length, then
+       ! we have found a match and are finished.  Otherwise, we cycle on to
+       ! the next item in aList.
+
+       if(nMatch == itemLength) then 
+	  index_ = i
+	  EXIT
+       endif
+
+! Old code that does not work with V. of the IBM 
+!    if(item==toChar(aList%bf(lb:le))) then
+!      index_=i
+!      exit
+    endif
+  end do ITEM_COMPARE
+
+ end function index_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: indexStr_ - Return Rank in a List of a Given Item (String)
+!
+! !DESCRIPTION:
+! This function performs the same operation as the function 
+! {\tt index\_()}, but the item to be indexed is instead presented in 
+! the form of a {\tt String} datatype (see the module {\tt m\_String} 
+! for more information about the {\tt String} type).  This routine 
+! searches through the input {\tt List} argument {\tt aList} for an 
+! item that matches the item defined by {\tt itemStr}, and if a match 
+! is found, the rank of the item in the list is returned (see also the 
+! prologue for the routine {\tt index\_()} in this module).  If no match 
+! is found, a value of zero is returned.
+!
+! !INTERFACE:
+
+ integer function indexStr_(aList, itemStr)
+
+! !USES:
+!
+      use m_String,only : String,toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),      intent(in) :: aList	! a List of names
+      type(String),    intent(in) :: itemStr
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 25Oct02 - R. Jacob <jacob@mcs.anl.gov> - just call index_ above
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::indexStr_'
+
+  indexStr_=0
+  indexStr_=index_(aList,toChar(itemStr))
+
+ end function indexStr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: allocated_ - Check Pointers in a List for Association Status
+!
+! !DESCRIPTION:
+! This function checks the input {\tt List} argument {\tt inList} to 
+! determine whether or not it has been allocated.  It does this by 
+! invoking the Fortran90 intrinsic function {\tt associated()} on the 
+! pointers {\tt inList\%bf} and {\tt inList\%lc}.  If both of these 
+! pointers are associated, the return value is {\tt .TRUE.}.
+!
+! {\bf N.B.:}  In Fortran90, pointers have three different states:   
+! {\tt ASSOCIATED}, {\tt UNASSOCIATED}, and {\tt UNDEFINED}.
+!  If a pointer is {\tt UNDEFINED}, this function may return either 
+! {\tt .TRUE.} or {\tt .FALSE.} values, depending on the Fortran90 
+! compiler.  To avoid such problems, we advise that users invoke the 
+! {\tt List} method {\tt nullify()} to nullify any {\tt List} pointers
+! for {\tt List} variables that are not initialized.
+!
+! !INTERFACE:
+
+ logical function allocated_(inList)
+
+! !USES:
+
+      use m_die,only : die
+
+      implicit none
+
+! !INPUT PARAMETERS:
+
+      type(List), intent(in) :: inList
+
+! !REVISION HISTORY:
+! 14Dec01 - J. Larson <larson@mcs.anl.gov> - inital version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::allocated_'
+
+  allocated_ = associated(inList%bf) .and. associated(inList%lc)
+
+ end function allocated_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: copy_ - Copy a List
+!
+! !DESCRIPTION:
+! This routine copies the contents of the input {\tt List} argument 
+! {\tt xL} into the output {\tt List} argument {\tt yL}.
+!
+! !INTERFACE:
+
+ subroutine copy_(yL,xL)	! yL=xL
+
+! !USES:
+!
+      use m_die,only : die
+      use m_stdio
+      use m_String ,only : String
+      use m_String ,only : String_clean
+      use m_mall,only : mall_mci,mall_ison
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),intent(in)  :: xL
+
+! !OUTPUT PARAMETERS:   
+!
+      type(List),intent(out) :: yL
+
+
+! !REVISION HISTORY:
+! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 16May01 - J. Larson <larson@mcs.anl.gov> - simpler, working 
+!           version that exploits the String datatype (see m_String)
+!  1Aug02 - Larson/Ong - Added logic for correct copying of blank 
+!           Lists.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::copy_'
+  type(String) DummStr
+
+  if(size(xL%lc,2) > 0) then
+
+       ! Download input List info from xL to String DummStr
+
+     call getall_(DummStr,xL)
+
+       ! Initialize yL from DummStr
+
+     call initStr_(yL,DummStr)
+
+     call String_clean(DummStr)
+
+  else
+     if(size(xL%lc,2) < 0) then ! serious error...
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: FATAL size(xL%lc,2) = ',size(xL%lc,2)
+     endif
+       ! Initialize yL as a blank list
+     call init_(yL, ' ')
+  endif
+
+ end subroutine copy_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportToChar_ - Export List to a CHARACTER
+!
+! !DESCRIPTION:  This function returns the character buffer portion of
+! the input {\tt List} argument {\tt inList}---that is, the contents of
+! {\tt inList\%bf}---as a {\tt CHARACTER} (suitable for printing).  An
+! example of the use of this function is:
+! \begin{verbatim}
+!           write(stdout,'(1a)') exportToChar(inList) 
+! \end{verbatim}
+! which writes the contents of {\tt inList\%bf} to the Fortran device 
+! {\tt stdout}.
+!
+! !INTERFACE:
+
+ function exportToChar_(inList)
+
+! !USES:
+!
+      use m_die,    only : die
+      use m_stdio,  only : stderr
+      use m_String, only : String
+      use m_String, only : String_ToChar => toChar
+      use m_String, only : String_clean
+
+      implicit none
+
+! ! INPUT PARAMETERS:
+
+      type(List),        intent(in)  :: inList
+
+! ! OUTPUT PARAMETERS:
+
+      character(len=size(inList%bf,1)) :: exportToChar_
+
+! !REVISION HISTORY:
+! 13Feb02 - J. Larson <larson@mcs.anl.gov> - initial version.
+! 06Jun03 - R. Jacob <jacob@mcs.anl.gov> - return blank if List is not allocated
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportToChar_'
+  type(String) DummStr
+
+       ! Download input List info from inList to String DummStr
+  if(allocated_(inList)) then
+     call getall_(DummStr,inList)
+     exportToChar_ = String_ToChar(DummStr)
+     call String_clean(DummStr)
+  else
+     exportToChar_ = ''
+  endif
+
+ end function exportToChar_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: exportToString_ - Export List to a String
+!
+! !DESCRIPTION:  This function returns the character buffer portion of
+! the input {\tt List} argument {\tt inList}---that is, the contents of
+! {\tt inList\%bf}---as a {\tt String} (see the mpeu module m\_String 
+! for more information regarding the {\tt String} type).  This function
+! was created to circumvent problems with implementing inheritance of 
+! the function {\tt exportToChar\_()} to other datatypes build on top
+! of the {\tt List} type.
+!
+! !INTERFACE:
+
+ function exportToString_(inList)
+
+! !USES:
+!
+      use m_die,    only : die
+      use m_stdio,  only : stderr
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+
+      implicit none
+
+! ! INPUT PARAMETERS:
+
+      type(List),       intent(in) :: inList
+
+! ! OUTPUT PARAMETERS:
+
+      type(String)                 :: exportToString_
+
+! !REVISION HISTORY:
+! 14Aug02 - J. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::exportToString_'
+
+  if(allocated_(inList)) then
+     call getall_(exportToString_, inList)
+  else
+     call String_init(exportToString_, 'NOTHING')
+  endif
+
+ end function exportToString_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: CharBufferSize_ - Return size of a List's Character Buffer
+!
+! !DESCRIPTION:  This function returns the length of the character 
+! buffer portion of the input {\tt List} argument {\tt inList} (that 
+! is, the number of characters stored in {\tt inList\%bf}) as an
+! {\tt INTEGER}.  Suppose for the sake of argument that {\tt inList} 
+! was created using the following call to {\tt init\_()}:
+! \begin{verbatim}
+!  call init_(inList, 'Groucho:Harpo:Chico:Zeppo')
+! \end{verbatim}
+! Then, using the above example value of {\tt inList}, we can use 
+! {\tt CharBufferSize\_()} as follows:
+! \begin{verbatim}
+! integer :: BufferLength
+! BufferLength = CharBufferSize(inList) 
+! \end{verbatim}
+! and the resulting value of {\tt BufferLength} will be 25.
+!
+! !INTERFACE:
+
+ integer function CharBufferSize_(inList)
+
+! !USES:
+!
+      use m_die,    only : die
+      use m_stdio,  only : stderr
+
+      implicit none
+
+! ! INPUT PARAMETERS:
+
+      type(List),         intent(in) :: inList
+
+! !REVISION HISTORY:
+! 13Feb02 - J. Larson <larson@mcs.anl.gov> - initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::CharBufferSize_'
+
+  if(allocated_(inList)) then
+     CharBufferSize_ = size(inList%bf)
+  else
+     write(stderr,'(2a)') myname_,":: Argument inList not allocated."
+     call die(myname_)
+  endif
+
+ end function CharBufferSize_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: get_ - Retrieve a Numbered Item from a List as a String
+!
+! !DESCRIPTION:
+! This routine retrieves a numbered item (defined by the input 
+! {\tt INTEGER} argument {\tt ith}) from the input {\tt List} argument 
+! {\tt aList}, and returns it in the output {\tt String} argument 
+! {\tt itemStr} (see the module {\tt m\_String} for more information 
+! about the {\tt String} type).  If the argument {\tt ith} is nonpositive, 
+! or greater than the number of items in {\tt aList}, a String containing
+! one blank space is returned.
+!
+! !INTERFACE:
+
+ subroutine get_(itemStr, ith, aList)
+
+! !USES:
+!
+      use m_String, only : String, init, toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,     intent(in)  :: ith
+      type(List),  intent(in)  :: aList
+
+! !OUTPUT PARAMETERS:   
+!
+      type(String),intent(out) :: itemStr
+
+
+! !REVISION HISTORY:
+! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 14May07 - Larson, Jacob - add space to else case string so function
+!                           matches documentation.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::get_'
+  integer :: lb,le
+
+  if(ith>0 .and. ith <= size(aList%lc,2)) then
+    lb=aList%lc(0,ith)
+    le=aList%lc(1,ith)
+    call init(itemStr,toChar(aList%bf(lb:le)))
+  else
+    call init(itemStr,' ')
+  endif
+
+ end subroutine get_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getall_ - Return all Items from a List as one String
+!
+! !DESCRIPTION:
+! This routine returns all the items from the input {\tt List} argument
+! {\tt aList} in the output {\tt String} argument {\tt itemStr} (see 
+! the module {\tt m\_String} for more information about the {\tt String} 
+! type).  The contents of the character buffer in {\tt itemStr} will 
+! be the all of the items in {\tt aList}, separated by the colon delimiter.
+!
+! !INTERFACE:
+
+ subroutine getall_(itemStr, aList)
+
+! !USES:
+!
+      use m_String, only : String, init, toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),   intent(in)  :: aList
+
+! !OUTPUT PARAMETERS:   
+!
+      type(String), intent(out) :: itemStr
+
+
+! !REVISION HISTORY:
+! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getall_'
+  integer :: lb,le,ni
+
+  ni=size(aList%lc,2)
+  lb=aList%lc(0,1)
+  le=aList%lc(1,ni)
+  call init(itemStr,toChar(aList%bf(lb:le)))
+
+ end subroutine getall_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getrange_ - Return a Range of Items from a List as one String
+!
+! !DESCRIPTION:
+! This routine returns all the items ranked {\tt i1} through {\tt i2} 
+! from the input {\tt List} argument {\tt aList} in the output 
+! {\tt String} argument {\tt itemStr} (see the module {\tt m\_String} 
+! for more information about the {\tt String} type).  The contents of 
+! the character buffer in {\tt itemStr} will be items in {\tt i1} through 
+! {\tt i2} {\tt aList}, separated by the colon delimiter.
+!
+! !INTERFACE:
+
+ subroutine getrange_(itemStr, i1, i2, aList)
+
+! !USES:
+!
+      use m_die,    only : die
+      use m_stdio,  only : stderr
+      use m_String, only : String,init,toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,     intent(in)  :: i1
+      integer,     intent(in)  :: i2
+      type(List),  intent(in)  :: aList
+
+! !OUTPUT PARAMETERS:   
+!
+      type(String),intent(out) :: itemStr
+
+! !REVISION HISTORY:
+! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 26Jul02 - J. Larson - Added argument checks.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getrange_'
+  integer :: lb,le,ni
+
+       ! Argument Sanity Checks:
+
+  if(.not. allocated_(aList)) then
+     write(stderr,'(2a)') myname_, &
+	  ':: FATAL--List argument aList is not initialized.'
+     call die(myname_)
+  endif
+
+       ! is i2 >= i1 as we assume?
+
+  if(i1 > i2) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: FATAL.  Starting/Ending item ranks are out of order; ', &
+	  'i2 must be greater or equal to i1.  i1 =',i1,' i2 = ',i2
+     call die(myname_)
+  endif
+
+  ni=size(aList%lc,2) ! the number of items in aList...
+
+       ! is i1 or i2 too big?
+
+  if(i1 > ni) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: FATAL--i1 is greater than the number of items in ', &
+	  'The List argument aList: i1 =',i1,' ni = ',ni
+     call die(myname_)
+  endif
+
+  if(i2 > ni) then
+     write(stderr,'(2a,2(a,i8))') myname_, &
+	  ':: FATAL--i2 is greater than the number of items in ', &
+	  'The List argument aList: i2 =',i2,' ni = ',ni
+     call die(myname_)
+  endif
+
+       ! End of Argument Sanity Checks.
+
+  lb=aList%lc(0,max(1,i1))
+  le=aList%lc(1,min(ni,i2))
+  call init(itemStr,toChar(aList%bf(lb:le)))
+
+ end subroutine getrange_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: identical_ - Compare Two Lists for Equality
+!
+! !DESCRIPTION:
+! This function compares the string buffer and indexing information in
+! the two input {\tt List} arguments {\tt yL} and {\tt xL}.  If the 
+! string buffers and index buffers of {\tt yL} and {\tt xL} match, this
+! function returns a value of {\tt .TRUE.}  Otherwise, it returns a 
+! value of {\tt .FALSE.}
+!
+! !INTERFACE:
+
+ logical function identical_(yL, xL)
+
+! !USES:
+!
+      use m_die,only : die
+      use m_String ,only : String
+      use m_String ,only : String_clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List), intent(in) :: yL
+      type(List), intent(in) :: xL
+
+! !REVISION HISTORY:
+! 14Oct01 - J. Larson <larson@mcs.anl.gov> - original version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::identical_'
+
+  logical :: myIdentical
+  type(String) :: DummStr
+  integer :: n, NumItems
+
+       ! Compare the number of the items in the Lists xL and yL.
+       ! If they differ, myIdentical is set to .FALSE. and we are
+       ! finished.  If both Lists sport the same number of items,
+       ! we must compare them one-by-one...
+
+  myIdentical = .FALSE.
+
+  if(nitem_(yL) == nitem_(xL)) then
+
+     NumItems = nitem_(yL)
+
+     COMPARE_LOOP:  do n=1,NumItems
+
+	call get_(DummStr, n, yL)  ! retrieve nth tag as a String
+
+	if( indexStr_(xL, Dummstr) /= n ) then ! a discrepency spotted.
+	   call String_clean(Dummstr)
+	   myIdentical = .FALSE.    
+	   EXIT
+	else
+	   call String_clean(Dummstr)
+	endif
+
+	   myIdentical = .TRUE.   ! we survived the whole test process.
+
+     end do COMPARE_LOOP
+
+  endif
+
+  identical_ = myIdentical
+
+ end function identical_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: get_indices_ - Index Multiple Items in a List
+!
+! !DESCRIPTION:  This routine takes as input a {\tt List} argument 
+! {\tt aList}, and a {\tt CHARACTER} string {Values}, which is a colon-
+! delimited string of items, and returns an {\tt INTEGER} array 
+! {\tt indices(:)}, which contain the rank of each item in {\tt aList}.
+! For example, suppose {\tt aList} was created from the character string
+! \begin{verbatim}
+! 'happy:sleepy:sneezey:grumpy:dopey::bashful:doc'
+! \end{verbatim}
+! and get\_indices\_() is invoked as follows:
+! \begin{verbatim}
+! call get_indices_(indices, aList, 'sleepy:grumpy:bashful:doc')
+! \end{verbatim}
+! The array {\tt indices(:)} will be returned with 4 entries:  
+! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
+! ${\tt indices(4)}=7$.
+!
+! {\bf N.B.}:  This routine operates on the assumption that each of the 
+! substrings in the colon-delimited string {\tt Values} is an item in 
+! {\tt aList}.  If this assumption is invalid, this routine terminates 
+! execution with an error message.
+!
+! {\bf N.B.}:  The pointer {\tt indices} must be {\tt UNASSOCIATED} on entry 
+! to this routine, and will be {\tt ASSOCIATED} upon return.  After this pointer
+! is no longer needed, it should be deallocated.  Failure to do so will result 
+! in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine get_indices_(indices, aList, Values)
+
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+      use m_String, only : String_toChar => toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),            intent(in)	:: aList  ! an indexed string values
+      character(len=*),      intent(in) :: Values ! ":" delimited names
+
+! !OUTPUT PARAMETERS:   
+!
+      integer, dimension(:), pointer    :: indices
+
+! !REVISION HISTORY:
+! 31May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 12Feb03 - J. Larson <larson@mcs.anl.gov> Working refactored version  
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::get_indices_'
+  type(List)   :: tList
+  type(String) :: tStr
+  integer :: i, ierr, n
+
+       ! Create working list based on input colon-delimited string
+
+  call init_(tList, values)
+
+
+       ! Count items in tList and allocate indices(:) accordingly
+
+  n = nitem_(tList)
+
+  if(n > nitem_(aList)) then
+     write(stderr,'(5a,2(i8,a))') myname_, &
+	  ':: FATAL--more items in argument Values than aList!  Input string', &
+	  'Values = "',Values,'" has ',n,' items.  aList has ',nitem_(aList),  &
+	  ' items.'
+     call die(myname_)
+  endif
+  allocate(indices(n), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8,a)') myname_, &
+	  ':: FATAL--allocate(indices(...) failed with stat=',ierr,&
+	  '.  On entry to this routine, this pointer must be NULL.'
+     call die(myname_)
+  endif
+
+       ! Retrieve each item from tList as a String and index it
+
+  do i=1,n
+    call get_(tStr,i,tList)
+    indices(i) = indexStr_(aList,tStr)
+    if(indices(i) == 0) then ! ith item not present in aList!
+       write(stderr,'(4a)') myname_, &
+	    ':: FATAL--item "',String_toChar(tStr),'" not found.'
+       call die(myname_)
+    endif
+    call String_clean(tStr)
+  end do
+
+       ! Clean up temporary List tList
+
+  call clean_(tList)
+
+ end subroutine get_indices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: test_indices_ - Test/Index Multiple Items in a List
+!
+! !DESCRIPTION:  This routine takes as input a {\tt List} argument 
+! {\tt aList}, and a {\tt CHARACTER} string {Values}, which is a colon-
+! delimited string of items, and returns an {\tt INTEGER} array 
+! {\tt indices(:)}, which contain the rank of each item in {\tt aList}.
+! For example, suppose {\tt aList} was created from the character string
+! \begin{verbatim}
+! 'happy:sleepy:sneezey:grumpy:dopey::bashful:doc'
+! \end{verbatim}
+! and {\tt test\_indices\_()} is invoked as follows:
+! \begin{verbatim}
+! call test_indices_(indices, aList, 'sleepy:grumpy:bashful:doc')
+! \end{verbatim}
+! The array {\tt indices(:)} will be returned with 4 entries:  
+! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
+! ${\tt indices(4)}=7$.
+!
+! Now suppose {\tt test\_indices\_()} is invoked as follows:
+! \begin{verbatim}
+! call test_indices_(indices, aList, 'sleepy:grumpy:bashful:Snow White')
+! \end{verbatim}
+! The array {\tt indices(:)} will be returned with 4 entries:  
+! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
+! ${\tt indices(4)}=0$.
+!
+! {\bf N.B.}:  This routine operates on the assumption that one or more 
+! of the substrings in the colon-delimited string {\tt Values} is may not 
+! be an item in {\tt aList}.  If an item in {\tt Values} is {\em not} in 
+! {\tt aList}, its corresponding entry in {\tt indices(:)} is set to zero.
+!
+! {\bf N.B.}:  The pointer {\tt indices} must be {\tt UNASSOCIATED} on entry 
+! to this routine, and will be {\tt ASSOCIATED} upon return.  After this pointer
+! is no longer needed, it should be deallocated.  Failure to do so will result 
+! in a memory leak.
+!
+! !INTERFACE:
+
+ subroutine test_indices_(indices, aList, Values)
+
+! !USES:
+!
+      use m_stdio
+      use m_die
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+      use m_String, only : String_toChar => toChar
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),            intent(in)	:: aList  ! an indexed string values
+      character(len=*),      intent(in) :: Values ! ":" delimited names
+
+! !OUTPUT PARAMETERS:   
+!
+      integer, dimension(:), pointer    :: indices
+
+! !REVISION HISTORY:
+! 12Feb03 - J. Larson <larson@mcs.anl.gov> Working refactored version  
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::test_indices_'
+  type(List)   :: tList
+  type(String) :: tStr
+  integer :: i, ierr, n
+
+       ! Create working list based on input colon-delimited string
+
+  call init_(tList, values)
+
+
+       ! Count items in tList and allocate indices(:) accordingly
+
+  n = nitem_(tList)
+  allocate(indices(n), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8,a)') myname_, &
+	  ':: FATAL--allocate(indices(...) failed with stat=',ierr,&
+	  '.  On entry to this routine, this pointer must be NULL.'
+     call die(myname_)
+  endif
+
+       ! Retrieve each item from tList as a String and index it
+
+  do i=1,n
+    call get_(tStr,i,tList)
+    indices(i) = indexStr_(aList,tStr)
+    call String_clean(tStr)
+  end do
+
+       ! Clean up temporary List tList
+
+  call clean_(tList)
+
+ end subroutine test_indices_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: append_ - Append One List Onto the End of Another
+!
+! !DESCRIPTION:  This routine takes two {\tt List} arguments
+! {\tt iList1} and {\tt iList2}, and appends {\tt List2} onto 
+! the end of {\tt List1}.
+!
+! {\bf N.B.}:  There is no check for shared items in the arguments 
+! {\tt List1} and {\tt List2}.  It is the user's responsibility to 
+! ensure {\tt List1} and {\tt List2} share no items.  If this routine
+! is invoked in such a manner that {\tt List1} and {\tt List2} share
+! common items, the resultant value of {\tt List1} will produce 
+! ambiguous results for some of the {\tt List} query functions.
+!
+! {\bf N.B.}:  The outcome of this routine is order dependent.  That is,
+! the entries of {\tt iList2} will follow the {\em input} entries in 
+! {\tt iList1}.
+!
+! !INTERFACE:
+
+    subroutine append_(iList1, iList2)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die, only : die
+
+      use m_mpif90
+
+      use m_String, only:  String
+      use m_String, only:  String_toChar => toChar
+      use m_String, only:  String_len
+      use m_String, only:  String_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),         intent(in)    :: iList2 
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(List),         intent(inout) :: iList1
+
+! !REVISION HISTORY:
+!  6Aug02 - J. Larson - Initial version
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::append_'
+
+  type(List) :: DummyList
+
+  call copy_(DummyList, iList1)
+  call clean_(iList1)
+  call concatenate(DummyList, iList2, iList1)
+  call clean_(DummyList)
+
+ end subroutine append_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: concatenate_ - Concatenates two Lists to form a Third List.
+!
+! !DESCRIPTION:  This routine takes two input {\tt List} arguments
+! {\tt iList1} and {\tt iList2}, and concatenates them, producing an 
+! output {\tt List} argument {\tt oList}.
+!
+! {\bf N.B.}:  The nature of this routine is such that one must 
+! {\bf never} supply as the actual value of {\tt oList} the same 
+! value supplied for either {\tt iList1} or {\tt iList2}.
+!
+! {\bf N.B.}:  The outcome of this routine is order dependent.  That is,
+! the entries of {\tt iList2} will follow {\tt iList1}.
+!
+! !INTERFACE:
+
+    subroutine concatenate_(iList1, iList2, oList)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die, only : die
+
+      use m_mpif90
+
+      use m_String, only:  String
+      use m_String, only:  String_init => init
+      use m_String, only:  String_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),         intent(in)  :: iList1
+      type(List),         intent(in)  :: iList2 
+
+! !OUTPUT PARAMETERS: 
+!
+      type(List),         intent(out) :: oList
+
+! !BUGS:  For now, the List concatenate algorithm relies on fixed-length
+! CHARACTER variables as intermediate storage.  The lengths of these
+! scratch variables is hard-wired to 10000, which should be large enough
+! for most applications.  This undesirable feature should be corrected 
+! ASAP.
+!
+! !REVISION HISTORY:
+!  8May01 - J.W. Larson - initial version.
+! 17May01 - J.W. Larson - Re-worked and tested successfully.
+! 17Jul02 - E. Ong - fixed the bug mentioned above
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::concatenate_'
+
+ character, dimension(:), allocatable :: CatBuff
+ integer :: CatBuffLength, i, ierr, Length1, Length2
+ type(String) :: CatString
+
+       ! First, handle the case of either iList1 and/or iList2 being
+       ! null
+
+  if((nitem_(iList1) == 0) .or. (nitem_(iList2) == 0)) then
+
+     if((nitem_(iList1) == 0) .and. (nitem_(iList2) == 0)) then
+	call init_(oList,'')
+     else
+	if((nitem_(iList1) == 0) .and. (nitem_(iList2) > 0)) then
+	   call copy_(oList, iList2)
+	endif
+	if((nitem_(iList1) > 0) .and. (nitem_(iList2) == 0)) then
+	   call copy_(oList,iList1)
+	endif
+     endif
+
+  else ! both lists are non-null
+
+       ! Step one:  Get lengths of character buffers of iList1 and iList2:
+
+     Length1 = CharBufferSize_(iList1)
+     Length2 = CharBufferSize_(iList2)
+
+       ! Step two:  create CatBuff(:) as workspace
+
+     CatBuffLength =  Length1 + Length2 + 1
+     allocate(CatBuff(CatBuffLength), stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: FATAL--allocate(CatBuff(...) failed.  ierr=',ierr
+	call die(myname_)
+     endif
+
+       ! Step three:  concatenate CHARACTERs with the colon separator
+       ! into CatBuff(:)
+
+     do i=1,Length1
+	CatBuff(i) = iList1%bf(i)
+     end do
+
+     CatBuff(Length1 + 1) = ':'
+
+     do i=1,Length2
+	CatBuff(Length1 + 1 + i) = iList2%bf(i)
+     end do
+
+       ! Step four:  initialize a String CatString:
+
+     call String_init(CatString, CatBuff)
+
+       ! Step five:  initialize oList:
+
+     call  initStr_(oList, CatString)
+
+       ! The concatenation is complete.  Now, clean up
+
+     call String_clean(CatString)
+
+     deallocate(CatBuff,stat=ierr)
+     if(ierr /= 0) then
+	write(stderr,'(2a,i8)') myname_, &
+	     ':: FATAL--deallocate(CatBuff) failed.  ierr=',ierr
+	call die(myname_)
+     endif
+
+  endif
+
+ end subroutine concatenate_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - MPI Broadcast for the List Type
+!
+! !DESCRIPTION:  This routine takes an input {\tt List} argument 
+! {\tt iList} (on input, valid on the root only), and broadcasts it.
+!
+! {\bf N.B.}:  The outcome of this routine, {\tt ioList} on non-root
+! processes, represents allocated memory.  When this {\tt List} is
+! no longer needed, it must be deallocated by invoking the routine 
+! {\tt List\_clean()}.  Failure to do so will cause a memory leak.
+!
+! !INTERFACE:
+
+    subroutine bcast_(ioList, root, comm, status)
+!
+! !USES:
+!
+      use m_stdio,  only : stderr
+      use m_die, only : MP_perr_die, die
+
+      use m_String, only:  String
+      use m_String, only:  String_bcast => bcast
+      use m_String, only:  String_clean => clean
+
+      use m_mpif90
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,            intent(in)     :: root
+      integer,            intent(in)     :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(List),         intent(inout)  :: ioList  
+
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional,  intent(out)    :: status
+
+! !REVISION HISTORY:
+!  7May01 - J.W. Larson - initial version.
+! 14May01 - R.L. Jacob - fix error checking
+! 16May01 - J.W. Larson - new, simpler String-based algorigthm
+!           (see m_String for details), which works properly on
+!           the SGI platform.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!           (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::bcast_'
+ integer :: myID, ierr
+ type(String) :: DummStr
+
+      ! Initialize status (if present)
+
+  if(present(status)) status = 0
+
+       ! Which process am I?
+
+  call MPI_COMM_RANK(comm, myID, ierr)
+  if(ierr /= 0) then
+   if(present(status)) then
+     status = ierr
+     write(stderr,'(2a,i4)') myname_,":: MPI_COMM_RANK(), ierr=",ierr
+     return
+   else
+     call MP_perr_die(myname_,"MPI_COMM_RANK()",ierr)
+   endif
+  endif
+
+       ! on the root, convert ioList into the String variable DummStr
+
+  if(myID == root) then
+     if(CharBufferSize_(ioList) <= 0) then
+	call die(myname_, 'Attempting to broadcast an empty list!',&
+	     CharBufferSize_(ioList))
+     endif
+     call getall_(DummStr, ioList)
+  endif
+
+       ! Broadcast DummStr
+
+  call String_bcast(DummStr, root, comm, ierr)
+  if(ierr /= 0) then
+   if(present(status)) then
+     status = ierr
+     write(stderr,'(2a,i4)') myname_,":: call String_bcast(), ierr=",ierr
+     return
+   else
+     call MP_perr_die(myname_,"String_bcast() failed, stat=",ierr)
+   endif
+  endif
+
+       ! Initialize ioList off the root using DummStr
+
+  if(myID /= root) then
+     call initStr_(ioList, DummStr)
+  endif
+
+       ! And now, the List broadcast is complete.
+
+  call String_clean(DummStr)
+
+ end subroutine bcast_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: send_ - MPI Point-to-Point Send for the List Type
+!
+! !DESCRIPTION:  This routine takes an input {\tt List} argument 
+! {\tt inList} and sends it to processor {\tt dest} on the communicator 
+! associated with the fortran 90 {\tt INTEGER} handle {\tt comm}.  The 
+! message is tagged by the input {\tt INTEGER} argument {\tt TagBase}.  
+! The success (failure) of this operation is reported in the zero 
+! (nonzero) optional output argument {\tt status}.
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! {\tt TagBase} and {\tt TagBase+1}.  This is because {\tt send\_()} 
+! performs the send of the {\tt List} as a pair of operations.  The 
+! first send is the number of characters in {\tt inList\%bf}, and is 
+! given MPI tag value {\tt TagBase}.  The second send is the 
+! {\tt CHARACTER} data present in {\tt inList\%bf}, and is given MPI 
+! tag value {\tt TagBase+1}.
+!
+! !INTERFACE:
+
+    subroutine send_(inList, dest, TagBase, comm, status)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die, only : MP_perr_die
+
+      use m_mpif90
+
+      use m_String, only:  String
+      use m_String, only:  String_toChar => toChar
+      use m_String, only:  String_len
+      use m_String, only:  String_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),         intent(in)  :: inList  
+      integer,            intent(in)  :: dest
+      integer,            intent(in)  :: TagBase
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional,  intent(out) :: status
+
+! !REVISION HISTORY:
+!  6Jun01 - J.W. Larson - initial version.
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!           (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::send_'
+
+ type(String) :: DummStr
+ integer :: ierr, length
+
+       ! Set status flag to zero (success) if present:
+
+ if(present(status)) status = 0
+
+       ! Step 1.  Extract CHARACTER buffer from inList and store it
+       ! in String variable DummStr, determine its length.
+
+ call getall_(DummStr, inList)
+ length = String_len(DummStr)
+
+       ! Step 2.  Send Length of String DummStr to process dest.
+
+ call MPI_SEND(length, 1, MP_type(length), dest, TagBase, comm, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+        write(stderr,'(2a,i8)') myname_, &
+	     ':: MPI_SEND(length...) failed.  ierror=', ierr
+        status = ierr
+        return
+     else
+        call MP_perr_die(myname_,':: MPI_SEND(length...) failed',ierr)
+     endif
+  endif
+
+       ! Step 3.  Send CHARACTER portion of String DummStr 
+       ! to process dest.
+
+ call MPI_SEND(DummStr%c(1), length, MP_CHARACTER, dest, TagBase+1, &
+               comm, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+        write(stderr,'(2a,i8)') myname_, &
+	     ':: MPI_SEND(DummStr%c...) failed.  ierror=', ierr
+        status = ierr
+        return
+     else
+        call MP_perr_die(myname_,':: MPI_SEND(DummStr%c...) failed',ierr)
+     endif
+  endif
+
+ end subroutine send_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: recv_ - MPI Point-to-Point Receive for the List Type
+!
+! !DESCRIPTION:  This routine receives the output {\tt List} argument 
+! {\tt outList} from processor {\tt source} on the communicator associated
+! with the fortran 90 {\tt INTEGER} handle {\tt comm}.  The message is
+! tagged by the input {\tt INTEGER} argument {\tt TagBase}.  The success
+! (failure) of this operation is reported in the zero (nonzero) optional
+! output argument {\tt status}.
+!
+! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
+! {\tt TagBase} and {\tt TagBase+1}.  This is because {\tt recv\_()} 
+! performs the receive of the {\tt List} as a pair of operations.  The 
+! first receive is the number of characters in {\tt outList\%bf}, and 
+! is given MPI tag value {\tt TagBase}.  The second receive is the 
+! {\tt CHARACTER} data present in {\tt outList\%bf}, and is given MPI 
+! tag value {\tt TagBase+1}.
+!
+! !INTERFACE:
+
+    subroutine recv_(outList, source, TagBase, comm, status)
+!
+! !USES:
+!
+      use m_stdio, only : stderr
+      use m_die,   only : MP_perr_die
+
+      use m_mpif90
+
+      use m_String, only : String
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,            intent(in)  :: source
+      integer,            intent(in)  :: TagBase
+      integer,            intent(in)  :: comm
+
+! !OUTPUT PARAMETERS: 
+!
+      type(List),         intent(out) :: outList  
+      integer, optional,  intent(out) :: status
+
+! !REVISION HISTORY:
+!  6Jun01 - J.W. Larson - initial version.
+! 11Jun01 - R. Jacob - small bug fix; status in MPI_RECV
+! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
+!           (if present).
+!EOP ___________________________________________________________________
+
+ character(len=*),parameter :: myname_=myname//'::recv_'
+
+ integer :: ierr, length
+ integer :: MPstatus(MP_STATUS_SIZE)
+ type(String) :: DummStr
+
+       ! Initialize status to zero (success), if present.
+
+  if(present(status)) status = 0
+
+       ! Step 1.  Receive Length of String DummStr from process source.
+
+ call MPI_RECV(length, 1, MP_type(length), source, TagBase, comm, &
+               MPstatus, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+        write(stderr,'(2a,i8)') myname_, &
+	     ':: MPI_RECV(length...) failed.  ierror=', ierr
+        status = ierr
+        return
+     else
+        call MP_perr_die(myname_,':: MPI_RECV(length...) failed',ierr)
+     endif
+  endif
+
+ allocate(DummStr%c(length), stat=ierr)
+
+       ! Step 2.  Send CHARACTER portion of String DummStr 
+       ! to process dest.
+
+ call MPI_RECV(DummStr%c(1), length, MP_CHARACTER, source, TagBase+1, &
+               comm, MPstatus, ierr)
+  if(ierr /= 0) then
+     if(present(status)) then
+        write(stderr,'(2a,i8)') myname_, &
+	     ':: MPI_RECV(DummStr%c...) failed.  ierror=', ierr
+        status = ierr
+        return
+     else
+        call MP_perr_die(myname_,':: MPI_RECV(DummStr%c...) failed',ierr)
+     endif
+  endif
+
+       ! Step 3.  Initialize outList.
+
+ call initStr_(outList, DummStr)
+
+ end subroutine recv_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GetSharedListIndices_ - Index Shared Items for Two Lists
+!
+! !DESCRIPTION:  {\tt GetSharedListIndices\_()} compares two user-
+! supplied {\tt List} arguments {\tt List1} and {\tt Lis2} to determine:  
+! the number of shared items {\tt NumShared}, and arrays of the locations 
+! {\tt Indices1} and {\tt Indices2} in {\tt List1} and {\tt List2}, 
+! respectively.
+!
+! {\bf N.B.:}  This routine returns two allocated arrays:  {\tt Indices1(:)} 
+! and {\tt Indices2(:)}.  Both of these arrays must be deallocated once they 
+! are no longer needed.  Failure to do this will create a memory leak.
+!
+! !INTERFACE:
+
+ subroutine GetSharedListIndices_(List1, List2, NumShared, Indices1, &
+                                   Indices2)
+
+!
+! !USES:
+!
+      use m_die,  only : MP_perr_die, die, warn
+
+      use m_String, only : String
+      use m_String, only : String_clean => clean
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(List),    intent(in)  :: List1
+      type(List),    intent(in)  :: List2
+
+! !OUTPUT PARAMETERS:   
+!
+      integer,           intent(out) :: NumShared
+
+      integer,dimension(:), pointer  :: Indices1
+      integer,dimension(:), pointer  :: Indices2
+
+! !REVISION HISTORY:
+!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GetSharedListIndices_'
+
+! Error flag
+  integer :: ierr
+
+! number of items in List1 and List2, respectively:
+  integer :: nitem1, nitem2
+
+! MAXIMUM number of matches possible:
+  integer :: NumSharedMax
+
+! Temporary storage for a string tag retrieved from a list:
+  type(String) :: tag
+
+! Loop counters / temporary indices:
+  integer :: n1, n2
+
+       ! Determine the number of items in each list:
+
+  nitem1 = nitem_(List1)
+  nitem2 = nitem_(List2)
+
+       ! The maximum number of list item matches possible
+       ! is the minimum(nitem1,nitem2):
+
+  NumSharedMax = min(nitem1,nitem2)
+
+       ! Allocate sufficient space for the matches we may find:
+
+  allocate(Indices1(NumSharedMax), Indices2(NumSharedMax), stat=ierr)
+  if(ierr /= 0) call die(myname_,'allocate() Indices1 and 2',ierr)
+
+       ! Initialize the counter for the number of matches found:
+
+  NumShared = 0
+
+       ! Scan through the two lists.  For the sake of speed, loop 
+       ! over the shorter of the two lists...
+
+  if(nitem1 <= nitem2) then ! List1 is shorter--scan it...
+
+     do n1=1,NumSharedMax
+
+       ! Retrieve string tag n1 from List1:
+        call get_(tag, n1, List1)
+
+       ! Index this tag WRT List2--a nonzero value signifies a match
+        n2 = indexStr_(List2, tag)
+
+       ! Clear out tag for the next iteration...
+        call String_clean(tag)
+
+       ! If we have a hit, update NumShared, and load the indices
+       ! n1 and n2 in Indices1 and Indices2, respectively...
+
+        if((0 < n2) .and. (n2 <= nitem2)) then
+           NumShared = NumShared + 1
+           Indices1(NumShared) = n1
+           Indices2(NumShared) = n2
+        endif
+
+     end do ! do n1=1,NumSharedMax
+
+  else ! List1 is shorter--scan it...
+
+     do n2=1,NumSharedMax
+
+       ! Retrieve string tag n2 from List2:
+        call get_(tag, n2, List2)
+
+       ! Index this tag WRT List1--a nonzero value signifies a match
+        n1 = indexStr_(List1, tag)
+
+       ! Clear out tag for the next iteration...
+        call String_clean(tag)
+
+       ! If we have a hit, update NumShared, and load the indices
+       ! n1 and n2 in Indices1 and Indices2, respectively...
+
+        if((0 < n1) .and. (n1 <= nitem1)) then
+           NumShared = NumShared + 1
+           Indices1(NumShared) = n1
+           Indices2(NumShared) = n2
+        endif
+
+     end do ! do n2=1,NumSharedMax
+
+  endif ! if(nitem1 <= nitem2)...
+
+ end subroutine GetSharedListIndices_
+
+ end module m_List
+!.
+
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_MergeSorts.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_MergeSorts.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_MergeSorts.F90	(revision 4775)
@@ -0,0 +1,1195 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_MergeSorts.F90,v 1.3 2004-04-21 22:54:45 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_MergeSorts - Tools for incremental indexed-sorting
+!
+! !DESCRIPTION:
+!
+!   This tool module contains basic sorting procedures, that in
+!   addition to a couple of standard Fortran 90 statements in the
+!   array syntex, allow a full range sort or unsort operations.
+!   The main characteristics of the sorting algorithm used in this
+!   module are, a) stable, and b) index sorting.
+!
+! !INTERFACE:
+
+    module m_MergeSorts
+      implicit none
+      private	! except
+
+      public :: IndexSet
+
+      public :: IndexSort
+
+      interface IndexSet
+	module procedure setn_
+	module procedure set_
+      end interface
+      interface IndexSort
+	module procedure iSortn_
+	module procedure rSortn_
+	module procedure dSortn_
+	module procedure cSortn_
+	module procedure iSort_
+	module procedure rSort_
+	module procedure dSort_
+	module procedure cSort_
+	module procedure iSort1_
+	module procedure rSort1_
+	module procedure dSort1_
+	module procedure cSort1_
+      end interface
+
+! !EXAMPLES:
+!
+!	...
+!	integer, intent(in) :: No
+!	type(Observations), dimension(No), intent(inout) :: obs
+!
+!	integer, dimension(No) :: indx	! automatic array
+!
+!	call IndexSet(No,indx)
+!	call IndexSort(No,indx,obs(1:No)%lev,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%lon,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%lat,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%kt,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%ks,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%kx,descend=.false.)
+!	call IndexSort(No,indx,obs(1:No)%kr,descend=.false.)
+!
+!		! Sorting
+!	obs(1:No) = obs( (/ (indx(i),i=1,No) /) )
+!     	...
+!		! Unsorting
+!	obs( (/ (indx(i),i=1,No) /) ) = obs(1:No)
+!     
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Added interfaces without the explicit size
+!		. Added interfaces for two dimensional arrays
+!	02Feb99 - Jing Guo <guo@thunder> - Added if(present(stat)) ...
+! 	04Jan99 - Jing Guo <guo@thunder> - revised
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*), parameter :: myname='MCT(MPEU)::m_MergeSorts'
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: setn_ - Initialize an array of data location indices
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine setn_(n,indx)
+      implicit none
+      integer, intent(in) :: n			! size of indx(:)
+      integer, dimension(n), intent(out) :: indx	! indices
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. redefined for the original interface
+!EOP ___________________________________________________________________
+
+  call set_(indx(1:n))
+end subroutine setn_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: set_ - Initialize an array of data location indices
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine set_(indx)
+      implicit none
+      integer, dimension(:), intent(out) :: indx	! indices
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Modified the interface, by removing the explicit size
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	04Jan99 - Jing Guo <guo@thunder> - revised prolog format
+!EOP ___________________________________________________________________
+
+  integer :: i
+
+  do i=1,size(indx)
+    indx(i)=i
+  end do
+
+end subroutine set_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: iSortn_ - A stable merge index sorting of INTs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine iSortn_(n,indx,keys,descend,stat)
+      implicit none
+
+      integer,intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      integer, dimension(n), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. redefined for the original interface
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::iSortn_'
+
+  call iSort_(indx(1:n),keys(1:n),descend,stat)
+end subroutine iSortn_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rSortn_ - A stable merge index sorting REALs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine rSortn_(n,indx,keys,descend,stat)
+      use m_realkinds,only : SP
+      implicit none
+
+      integer,intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      real(SP),dimension(n), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. redefined for the original interface
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rSortn_'
+
+  call rSort_(indx(1:n),keys(1:n),descend,stat)
+end subroutine rSortn_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dSortn_ - A stable merge index sorting DOUBLEs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine dSortn_(n,indx,keys,descend,stat)
+      use m_realkinds,only : DP
+      implicit none
+
+      integer,intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      real(DP), dimension(n), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. redefined for the original interface
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::dSortn_'
+
+  call dSort_(indx(1:n),keys(1:n),descend,stat)
+end subroutine dSortn_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cSortn_ - A stable merge index sorting of CHAR(*)s.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine cSortn_(n,indx,keys,descend,stat)
+      implicit none
+
+      integer,intent(in) :: n
+      integer, dimension(n), intent(inout) :: indx
+      character(len=*), dimension(n), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. redefined for the original interface
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::cSortn_'
+
+  call cSort_(indx(1:n),keys(1:n),descend,stat)
+end subroutine cSortn_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: iSort_ - A stable merge index sorting of INTs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine iSort_(indx,keys,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      integer, dimension(:), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Modified the interface, by removing the explicit size
+!	02Feb99 - Jing Guo <guo@thunder> - Added if(present(stat)) ...
+! 	04Jan99 - Jing Guo <guo@thunder> - revised the prolog
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::iSort_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(indx(l1)) .ge. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(indx(l1)) .le. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine iSort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rSort_ - A stable merge index sorting REALs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine rSort_(indx,keys,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      use m_realkinds,only : SP
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      real(SP),dimension(:), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Modified the interface, by removing the explicit size
+!	02Feb99 - Jing Guo <guo@thunder> - Added if(present(stat)) ...
+! 	04Jan99 - Jing Guo <guo@thunder> - revised the prolog
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::rSort_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(indx(l1)) .ge. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(indx(l1)) .le. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine rSort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dSort_ - A stable merge index sorting DOUBLEs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine dSort_(indx,keys,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      use m_realkinds,only : DP
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      real(DP), dimension(:), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Modified the interface, by removing the explicit size
+!	02Feb99 - Jing Guo <guo@thunder> - Added if(present(stat)) ...
+! 	04Jan99 - Jing Guo <guo@thunder> - revised the prolog
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::dSort_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(indx(l1)) .ge. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(indx(l1)) .le. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine dSort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cSort_ - A stable merge index sorting of CHAR(*)s.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine cSort_(indx,keys,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      character(len=*), dimension(:), intent(in) :: keys
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Modified the interface, by removing the explicit size
+!	02Feb99 - Jing Guo <guo@thunder> - Added if(present(stat)) ...
+! 	04Jan99 - Jing Guo <guo@thunder> - revised the prolog
+! 	09Sep97 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::cSort_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(indx(l1)) .ge. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(indx(l1)) .le. keys(indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine cSort_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: iSort1_ - A stable merge index sorting of INTs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine iSort1_(indx,keys,ikey,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      integer, dimension(:,:), intent(in) :: keys
+      integer,intent(in) :: ikey
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. Copied code from iSort_
+!		. Extended the interface and the algorithm to handle
+!		  2-d arrays with an index.
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::iSort1_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(ikey,indx(l1)) .ge. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(ikey,indx(l1)) .le. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine iSort1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rSort1_ - A stable merge index sorting REALs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine rSort1_(indx,keys,ikey,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      use m_realkinds,only : SP
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      real(SP),dimension(:,:), intent(in) :: keys
+      integer,intent(in) :: ikey
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. Copied code from rSort_
+!		. Extended the interface and the algorithm to handle
+!		  2-d arrays with an index.
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::rSort1_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(ikey,indx(l1)) .ge. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(ikey,indx(l1)) .le. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine rSort1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dSort1_ - A stable merge index sorting DOUBLEs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine dSort1_(indx,keys,ikey,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      use m_realkinds,only : DP
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      real(DP), dimension(:,:), intent(in) :: keys
+      integer,intent(in) :: ikey
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. Copied code from dSort_
+!		. Extended the interface and the algorithm to handle
+!		  2-d arrays with an index.
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::dSort1_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(ikey,indx(l1)) .ge. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(ikey,indx(l1)) .le. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine dSort1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: cSort1_ - A stable merge index sorting of CHAR(*)s.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine cSort1_(indx,keys,ikey,descend,stat)
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      integer, dimension(:), intent(inout) :: indx
+      character(len=*), dimension(:,:), intent(in) :: keys
+      integer,intent(in) :: ikey
+      logical, optional, intent(in)  :: descend
+      integer, optional, intent(out) :: stat
+
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. initial prototype/prolog/code
+!		. Copied code from cSort_
+!		. Extended the interface and the algorithm to handle
+!		  2-d arrays with an index.
+!EOP ___________________________________________________________________
+
+  logical :: dsnd
+  integer :: ierr
+  integer, dimension(:),allocatable :: mtmp
+  integer :: n
+
+  character(len=*),parameter :: myname_=myname//'::cSort1_'
+
+  if(present(stat)) stat=0
+
+  n=size(indx)
+
+  allocate(mtmp(n),stat=ierr)
+  if(ierr /= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': allocate(mtmp(:)) error, stat =',ierr
+    if(.not.present(stat)) call die(myname_)
+    stat=ierr
+    return
+  endif
+
+  dsnd=.false.
+  if(present(descend)) dsnd=descend
+
+  call MergeSort_()
+
+  deallocate(mtmp)
+
+contains
+subroutine MergeSort_()
+  implicit none
+  integer :: mstep,lstep
+  integer :: lb,lm,le
+
+  mstep=1
+  do while(mstep < n)
+    lstep=mstep*2
+
+    lb=1
+    do while(lb < n)
+      lm=lb+mstep
+      le=min(lm-1+mstep,n)
+
+      call merge_(lb,lm,le)
+      indx(lb:le)=mtmp(lb:le)
+      lb=le+1
+    end do
+
+    mstep=lstep
+  end do
+end subroutine MergeSort_
+
+subroutine merge_(lb,lm,le)
+  integer,intent(in) :: lb,lm,le
+  integer :: l1,l2,l
+
+  l1=lb
+  l2=lm
+  do l=lb,le
+    if(l2.gt.le) then
+      mtmp(l)=indx(l1)
+      l1=l1+1
+    elseif(l1.ge.lm) then
+      mtmp(l)=indx(l2)
+      l2=l2+1
+    else
+      if(dsnd) then
+        if(keys(ikey,indx(l1)) .ge. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      else
+        if(keys(ikey,indx(l1)) .le. keys(ikey,indx(l2))) then
+          mtmp(l)=indx(l1)
+          l1=l1+1
+        else
+          mtmp(l)=indx(l2)
+          l2=l2+1
+        endif
+      endif
+    endif
+  end do
+end subroutine merge_
+
+end subroutine cSort1_
+!-----------------------------------------------------------------------
+end module m_MergeSorts
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Permuter.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Permuter.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_Permuter.F90	(revision 4775)
@@ -0,0 +1,1284 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_Permuter.F90,v 1.4 2004-04-21 22:54:45 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_Permuter - permute/unpermute
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_Permuter
+      implicit none
+      private	! except
+
+      public :: permute	
+      public :: unpermute
+
+    interface permute; module procedure	&
+	permutei_,	&	! integer in place
+	permuteio_,	&	! integer with an output
+	permutei1_,	&	! integer in place
+	permuteio1_,	&	! integer with an output
+	permuter_,	&	! real in place
+	permutero_,	&	! real with an output
+	permuter1_,	&	! real in place
+	permutero1_,	&	! real with an output
+	permuted_,	&	! dble in place
+	permutedo_,	&	! dble with an output
+	permuted1_,	&	! dble in place
+	permutedo1_,	&	! dble with an output
+	permutel_,	&	! logical in place
+	permutelo_,	&	! logical with an output
+	permutel1_,	&	! logical in place
+	permutelo1_		! logical with an output
+    end interface
+
+    interface unpermute; module procedure	&
+	unpermutei_,	&	! integer in place
+	unpermuteio_,	&	! integer with an output
+	unpermutei1_,	&	! integer in place
+	unpermuteio1_,	&	! integer with an output
+	unpermuter_,	&	! real in place
+	unpermutero_,	&	! real with an output
+	unpermuter1_,	&	! real in place
+	unpermutero1_,	&	! real with an output
+	unpermuted_,	&	! dble in place
+	unpermutedo_,	&	! dble with an output
+	unpermuted1_,	&	! dble in place
+	unpermutedo1_,	&	! dble with an output
+	unpermutel_,	&	! logical in place
+	unpermutelo_,	&	! logical with an output
+	unpermutel1_,	&	! logical in place
+	unpermutelo1_		! logical with an output
+    end interface
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_Permuter'
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutei_ - permute an integer array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutei_(ary,indx,n)
+      use m_die
+      implicit none
+      integer,dimension(:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutei_'
+
+  integer,allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permuteio_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permutei_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuteio_ - permute an integer array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuteio_(aout,ary,indx,n)
+      implicit none
+      integer,dimension(:),intent(inout) :: aout
+      integer,dimension(:),intent(in ) :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuteio_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(i)=ary(l)
+  end do
+
+end subroutine permuteio_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutei_ - unpermute a _permuted_ integer array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutei_(ary,indx,n)
+      use m_die
+      implicit none
+      integer,dimension(:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutei_'
+
+  integer,allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermuteio_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermutei_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuteio_ - unpermute a _permuted_ integer array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuteio_(aout,ary,indx,n)
+      implicit none
+      integer,dimension(:),intent(inout) :: aout
+      integer,dimension(:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuteio_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(l)=ary(i)
+  end do
+
+end subroutine unpermuteio_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuter_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuter_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuter_'
+
+  real(kind(ary)),allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutero_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permuter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutero_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutero_(aout,ary,indx,n)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:),intent(inout) :: aout
+      real(SP),dimension(:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutero_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(i)=ary(l)
+  end do
+
+end subroutine permutero_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuter_ - unpermute a _permuted_ real array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuter_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuter_'
+
+  real(kind(ary)),allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutero_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermuter_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutero_ - unpermute a _permuted_ real array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutero_(aout,ary,indx,n)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:),intent(inout) :: aout
+      real(SP),dimension(:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutero_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(l)=ary(i)
+  end do
+
+end subroutine unpermutero_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuted_ - permute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuted_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuted_'
+
+  real(kind(ary)),allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutedo_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permuted_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutedo_ - permute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutedo_(aout,ary,indx,n)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:),intent(inout) :: aout
+      real(DP),dimension(:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutedo_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(i)=ary(l)
+  end do
+
+end subroutine permutedo_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuted_ - unpermute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuted_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuted_'
+
+  real(kind(ary)),allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutedo_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermuted_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutedo_ - unpermute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutedo_(aout,ary,indx,n)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:),intent(inout) :: aout
+      real(DP),dimension(:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutedo_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(l)=ary(i)
+  end do
+
+end subroutine unpermutedo_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutel_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutel_(ary,indx,n)
+      use m_die
+      implicit none
+      logical,dimension(:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutel_'
+
+  logical,allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutelo_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permutel_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutelo_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutelo_(aout,ary,indx,n)
+      implicit none
+      logical,dimension(:),intent(inout) :: aout
+      logical,dimension(:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutelo_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(i)=ary(l)
+  end do
+
+end subroutine permutelo_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutel_ - unpermute a _permuted_ logical array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutel_(ary,indx,n)
+      use m_die
+      implicit none
+      logical,dimension(:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutel_'
+
+  logical,allocatable,dimension(:) :: wk
+  integer :: i,ier
+
+  allocate(wk(n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutelo_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(i)=wk(i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermutel_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutelo_ - unpermute a _permuted_ logical array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutelo_(aout,ary,indx,n)
+      implicit none
+      logical,dimension(:),intent(inout) :: aout
+      logical,dimension(:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutelo_'
+
+  integer :: i,l
+
+  do i=1,n
+    l=indx(i)
+    aout(l)=ary(i)
+  end do
+
+end subroutine unpermutelo_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutei1_ - permute an integer array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutei1_(ary,indx,n)
+      use m_die
+      implicit none
+      integer,dimension(:,:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutei1_'
+
+  integer,allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permuteio1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permutei1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuteio1_ - permute an integer array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuteio1_(aout,ary,indx,n)
+      implicit none
+      integer,dimension(:,:),intent(inout) :: aout
+      integer,dimension(:,:),intent(in ) :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuteio1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,i)=ary(1:m,l)
+  end do
+
+end subroutine permuteio1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutei1_ - unpermute a _permuted_ integer array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutei1_(ary,indx,n)
+      use m_die
+      implicit none
+      integer,dimension(:,:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutei1_'
+
+  integer,allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermuteio1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermutei1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuteio1_ - unpermute a _permuted_ integer array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuteio1_(aout,ary,indx,n)
+      implicit none
+      integer,dimension(:,:),intent(inout) :: aout
+      integer,dimension(:,:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuteio1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,l)=ary(1:m,i)
+  end do
+
+end subroutine unpermuteio1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuter1_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuter1_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuter1_'
+
+  real(kind(ary)),allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutero1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permuter1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutero1_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutero1_(aout,ary,indx,n)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(inout) :: aout
+      real(SP),dimension(:,:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutero1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,i)=ary(1:m,l)
+  end do
+
+end subroutine permutero1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuter1_ - unpermute a _permuted_ real array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuter1_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuter1_'
+
+  real(kind(ary)),allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutero1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermuter1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutero1_ - unpermute a _permuted_ real array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutero1_(aout,ary,indx,n)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(inout) :: aout
+      real(SP),dimension(:,:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutero1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,l)=ary(1:m,i)
+  end do
+
+end subroutine unpermutero1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permuted1_ - permute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permuted1_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permuted1_'
+
+  real(kind(ary)),allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutedo1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permuted1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutedo1_ - permute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutedo1_(aout,ary,indx,n)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(inout) :: aout
+      real(DP),dimension(:,:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutedo1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,i)=ary(1:m,l)
+  end do
+
+end subroutine permutedo1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermuted1_ - unpermute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermuted1_(ary,indx,n)
+      use m_die
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(inout) :: ary
+      integer ,dimension(:),intent(in)    :: indx
+      integer ,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermuted1_'
+
+  real(kind(ary)),allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutedo1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermuted1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutedo1_ - unpermute a double precision array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutedo1_(aout,ary,indx,n)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(inout) :: aout
+      real(DP),dimension(:,:),intent(in)  :: ary
+      integer ,dimension(:),intent(in)  :: indx
+      integer ,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutedo1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,l)=ary(1:m,i)
+  end do
+
+end subroutine unpermutedo1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutel1_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutel1_(ary,indx,n)
+      use m_die
+      implicit none
+      logical,dimension(:,:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutel1_'
+
+  logical,allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call permutelo1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine permutel1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: permutelo1_ - permute a real array according to indx[]
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine permutelo1_(aout,ary,indx,n)
+      implicit none
+      logical,dimension(:,:),intent(inout) :: aout
+      logical,dimension(:,:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::permutelo1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,i)=ary(1:m,l)
+  end do
+
+end subroutine permutelo1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutel1_ - unpermute a _permuted_ logical array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutel1_(ary,indx,n)
+      use m_die
+      implicit none
+      logical,dimension(:,:),intent(inout) :: ary
+      integer,dimension(:),intent(in)    :: indx
+      integer,             intent(in)    :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutel1_'
+
+  logical,allocatable,dimension(:,:) :: wk
+  integer :: i,l,ier
+
+  l=size(ary,1)
+  allocate(wk(l,n),stat=ier)
+	if(ier/=0) call perr_die(myname_,'allocate()',ier)
+
+  call unpermutelo1_(wk,ary,indx,n)
+
+  do i=1,n
+    ary(:,i)=wk(:,i)
+  end do
+
+  deallocate(wk,stat=ier)
+	if(ier/=0) call perr_die(myname_,'deallocate()',ier)
+
+end subroutine unpermutel1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: unpermutelo1_ - unpermute a _permuted_ logical array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine unpermutelo1_(aout,ary,indx,n)
+      implicit none
+      logical,dimension(:,:),intent(inout) :: aout
+      logical,dimension(:,:),intent(in)  :: ary
+      integer,dimension(:),intent(in)  :: indx
+      integer,             intent(in)  :: n
+
+! !REVISION HISTORY:
+! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::unpermutelo1_'
+
+  integer :: i,l,m
+
+  m=min(size(aout,1),size(ary,1))
+  do i=1,n
+    l=indx(i)
+    aout(1:m,l)=ary(1:m,i)
+  end do
+
+end subroutine unpermutelo1_
+
+end module m_Permuter
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_SortingTools.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_SortingTools.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_SortingTools.F90	(revision 4775)
@@ -0,0 +1,96 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_SortingTools.F90,v 1.4 2004-04-21 22:54:46 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_SortingTools - A collection of different sorting tools
+!
+! !DESCRIPTION:
+!
+!	This module contains a collection of sorting utilities.  The
+!   utilities are accessed through three generic interfaces, IndexSet(),
+!   IndexSort(), and IndexBin().
+!
+!	Note that, a version of IndexBin() for real arguments is not
+!   implemented due to the difficulty of comparing two real values as
+!   being equal.  For example, a bin for real values may be specified
+!   as a single number, a range of two numbers, a number with an
+!   absolute error-bar, or a number with a relative error-bar.
+!
+!	In general, one may have to map both keys(:) and bins(:) to
+!   integer indices by the a given rule, then use the integer version
+!   of IndexBin() with the two integer index arrays to do the sorting.
+!   This mapping rule, however, is application dependent.
+!
+!	Also note that, in principle, it is possible to use both 
+!   IndexSort() and IndexBin() in the same sorting task.
+!
+! !INTERFACE:
+
+    module m_SortingTools
+
+      use m_MergeSorts		!only : IndexSet,IndexSort
+      use m_IndexBin_integer	!only : IndexBin
+      use m_IndexBin_char	!only : IndexBin
+      use m_IndexBin_logical	!only : IndexBin
+      use m_rankMerge		!only : RankSet,RankMerge,IndexedRankMerge
+      use m_Permuter		!only : Permute, Unpermute
+
+      implicit none
+
+      private	! except
+
+      public :: IndexSet	 ! define an initial list of indices
+      public :: IndexSort	 ! index for a new rank out of the old
+      public :: IndexBin	 ! index for sorting bins
+      public :: RankSet		 ! define an initial list of ranks
+      public :: RankMerge	 ! merge two arrays by re-ranking
+      public :: IndexedRankMerge ! index-merge two array segments
+      public :: Permute          ! permute array entries
+      public :: Unpermute        ! invert permutation
+
+! !EXAMPLES:
+!
+!	- An example of using IndexSet()/IndexSort() in combination with
+!   the convenience of the Fortran 90 array syntex can be found in the
+!   prolog of m_MergeSorts.
+!
+!	- An example of using IndexSet()/IndexBin(): Copying all "good"
+!   data to another array.
+!
+!	integer :: indx(n)
+!	call IndexSet(n,indx)
+!	call IndexBin(n,indx,allObs(:)%qcflag,GOOD,ln0=ln_GOOD)
+!
+!		! Copy all "good" data to another array
+!	goodObs(1:ln_GOOD)=allObs( indx(1:ln_GOOD) )
+!
+!		! Refill all "good" data back to their original places
+!	allObs( indx(1:ln_GOOD) ) = goodObs(1:ln_GOOD)
+!
+!	- Similarily, multiple keys may be used in an IndexBin() call
+!   to selectively sort the data.  The following code will move data
+!   with kt = kt_Us,kt_U,kt_Vs,kt_V up to the front:
+!
+!	call IndexBin(n,indx,allObs(:)%kt,(/kt_Us,kt_U,kt_Vs,kt_V/))
+!	allObs(1:n) = allObs( indx(1:n) )
+!
+!	- Additional applications can also be implemented with other
+!   argument combinations.
+!
+! !REVISION HISTORY:
+!	15Mar00	- Jing Guo
+!		. Added m_rankMerge module interface
+!	20Apr99 - Jing Guo
+!		- Commented "only" in use m_IndexBin_xxx to avoid an
+!		  apperent compiler bug on DEC/OSF1
+! 	17Feb99 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	19Oct00 - J.W. Larson <larson@mcs.anl.gov> - added Permuter and
+!                 Unpermuter to list of public functions.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_SortingTools'
+
+end module m_SortingTools
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StrTemplate.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StrTemplate.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StrTemplate.F90	(revision 4775)
@@ -0,0 +1,454 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_StrTemplate.F90,v 1.6 2004-04-21 22:54:46 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_StrTemplate - A template formatting a string with variables
+!
+! !DESCRIPTION:
+!
+!	A template resolver formatting a string with a string variable
+!   and time variables.  The format descriptors are similar to those
+!   used in the GrADS.
+!
+!	"%y4"	substitute with a 4 digit year
+!	"%y2"	a 2 digit year
+!	"%m1"	a 1 or 2 digit month
+!	"%m2"	a 2 digit month
+!	"%mc"	a 3 letter month in lower cases
+!	"%Mc"	a 3 letter month with a leading letter in upper case
+!	"%MC"	a 3 letter month in upper cases
+!	"%d1"	a 1 or 2 digit day
+!	"%d2"	a 2 digit day
+!	"%h1"	a 1 or 2 digit hour
+!	"%h2"	a 2 digit hour
+!	"%h3"	a 3 digit hour (?)
+!	"%n2"	a 2 digit minute
+!	"%s"	a string variable
+!	"%%"	a "%"
+!
+! !INTERFACE:
+
+    module m_StrTemplate
+      implicit none
+      private	! except
+
+      public :: StrTemplate	! Substitute variables in a template
+
+      interface StrTemplate
+	module procedure strTemplate_
+      end interface
+
+! !REVISION HISTORY:
+! 	01Jun99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+! 	19Jan01	- Jay Larson <larson@mcs.anl.gov> - removed numerous
+!                 double-quote characters appearing inside single-quote
+!                 blocks.  This was done to comply with pgf90.  Also,
+!                 numerous double-quote characters were removed from
+!                 within comment blocks because pgf90 kept trying to
+!                 interpret them (spooky).
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_StrTemplate'
+
+  character(len=3),parameter,dimension(12) :: mon_lc =	(/	&
+	'jan','feb','mar','apr','may','jun',	&
+	'jul','aug','sep','oct','nov','dec'	/)
+
+  character(len=3),parameter,dimension(12) :: mon_wd =	(/	&
+	'Jan','Feb','Mar','Apr','May','Jun',	&
+	'Jul','Aug','Sep','Oct','Nov','Dec'	/)
+
+  character(len=3),parameter,dimension(12) :: mon_uc =	(/	&
+	'JAN','FEB','MAR','APR','MAY','JUN',	&
+	'JUL','AUG','SEP','OCT','NOV','DEC'	/)
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: strTemplate_ - expanding a format template to a string
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine strTemplate_(str,tmpl,class,xid,nymd,nhms,stat)
+      use m_chars, only : uppercase
+      use m_stdio, only : stderr
+      use m_die,   only : die
+      implicit none
+
+      character(len=*),intent(out) :: str	! the output
+
+      character(len=*),intent(in ) :: tmpl	! a "format"
+
+      character(len=*),intent(in ),optional :: class
+			! choose a UNIX or a GrADS(defulat) type format
+
+      character(len=*),intent(in ),optional :: xid
+			! a string substituting a '%s'.  Trailing
+			! spaces will be ignored
+
+      integer,intent(in ),optional :: nymd
+			! yyyymmdd, substituting '%y4', '%y2', '%m1',
+			! '%m2', '%mc', '%Mc', and '%MC'
+
+      integer,intent(in ),optional :: nhms
+			! hhmmss, substituting '%h1', '%h2', '%h3',
+			! and '%n2'
+
+      integer,intent(out),optional :: stat
+			! error code
+
+! !REVISION HISTORY:
+! 	03Jun99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!       08Jan03 - R. Jacob <jacob@mcs.anl.gov>  Small change to get
+!          around IBM compiler bug.  Cant have character valued functions
+!          in case statements.  Fix found by Everest Ong.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::strTemplate_'
+  character(len=16) :: tmpl_class
+  character(len=16) :: tmp_upper
+
+  tmpl_class="GX"
+  if(present(class)) tmpl_class=class
+
+  tmp_upper = uppercase(tmpl_class)
+  select case(tmp_upper)
+
+  case("GX","GRADS")
+    call GX_(str,tmpl,xid,nymd,nhms,stat)
+
+  !case("UX","UNIX")	! yet to be implemented
+  !  call UX_(str,tmpl,xid,nymd,nhms,stat)
+
+  case default
+    write(stderr,'(4a)') myname_,': unknown class:  ',	&
+	trim(tmpl_class),'.'
+    if(.not.present(stat)) call die(myname_)
+    stat=-1
+    return
+  end select
+
+end subroutine strTemplate_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GX_ - evaluate a GrADS style string template
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine GX_(str,tmpl,xid,nymd,nhms,stat)
+      use m_stdio,only : stderr
+      use m_die,  only : die,perr
+      implicit none
+      character(len=*),intent(out) :: str
+      character(len=*),intent(in ) :: tmpl
+      character(len=*),optional,intent(in) :: xid
+      integer,optional,intent(in)  :: nymd
+      integer,optional,intent(in)  :: nhms
+      integer,optional,intent(out) :: stat
+
+! !REVISION HISTORY:
+! 	01Jun99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!       19Jan01 - Jay Larson <larson@mcs.anl.gov> - added
+!                 variable c1c2, to store c1//c2, which pgf90
+!                 would not allow as an argument to the 'select case'
+!                 statement.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GX_'
+
+  integer :: iy4,iy2,imo,idy
+  integer :: ihr,imn
+  integer :: i,i1,i2,m,k
+  integer :: ln_tmpl,ln_str
+  integer :: istp,kstp
+
+  character(len=1) :: c0,c1,c2
+  character(len=2) :: c1c2
+  character(len=4) :: sbuf
+!________________________________________
+	! Determine iyr, imo, and idy
+  iy4=-1
+  iy2=-1
+  imo=-1
+  idy=-1
+  if(present(nymd)) then
+	if(nymd < 0) then
+	  call perr(myname_,'nymd < 0',nymd)
+	  if(.not.present(stat)) call die(myname_)
+	  stat=1
+	  return
+	endif
+
+    i=nymd
+    iy4=i/10000
+    iy2=mod(iy4,100)
+      i=mod(i,10000)
+    imo=i/100
+      i=mod(i,100)
+    idy=i
+  endif
+!________________________________________
+	! Determine ihr and imn
+  ihr=-1
+  imn=-1
+  if(present(nhms)) then
+	if(nhms < 0) then
+	  call perr(myname_,'nhms < 0',nhms)
+	  if(.not.present(stat)) call die(myname_)
+	  stat=1
+	  return
+	endif
+
+    i=nhms
+    ihr=i/10000
+      i=mod(i,10000)
+    imn=i/100
+  endif
+!________________________________________
+
+  ln_tmpl=len_trim(tmpl)	! size of the format template
+  ln_str =len(str)		! size of the output string
+!________________________________________
+
+  if(present(stat)) stat=0
+
+str=""
+
+i=0; istp=1
+k=1; kstp=1
+
+do while( i+istp <= ln_tmpl )	! A loop over all tokens in (tmpl)
+
+  if(k>ln_Str) exit	! truncate the output here.
+
+  i=i+istp
+  c0=tmpl(i:i)
+
+  select case(c0)
+  case ("%")
+	!________________________________________
+
+    c1=""
+    i1=i+1
+    if(i1 <= ln_Tmpl) c1=tmpl(i1:i1)
+	!________________________________________
+
+    select case(c1)
+
+    case("s")
+      if(.not.present(xid)) then
+	write(stderr,'(2a)') myname_,	&
+		': optional argument expected, "xid="'
+	if(.not.present(stat)) call die(myname_)
+	stat=1
+	return
+      endif
+
+      istp=2
+      m=min(k+len_trim(xid)-1,ln_str)
+      str(k:m)=xid
+      k=m+1
+      cycle
+
+    case("%")
+
+      istp=2
+      str(k:k)="%"
+      k=k+1	! kstp=1
+      cycle
+
+    case default
+
+      c2=""
+      i2=i+2
+      if(i2 <= ln_Tmpl) c2=tmpl(i2:i2)
+	!________________________________________
+
+      c1c2 = c1 // c2
+      select case(c1c2)
+
+      case("y4","y2","m1","m2","mc","Mc","MC","d1","d2")
+        if(.not.present(nymd)) then
+	  write(stderr,'(2a)') myname_,	&
+		': optional argument expected, "nymd="'
+	  if(.not.present(stat)) call die(myname_)
+	  stat=1
+	  return
+        endif
+        istp=3
+
+      case("h1","h2","h3","n2")
+        if(.not.present(nhms)) then
+	  write(stderr,'(2a)') myname_,	&
+		': optional argument expected, "nhms="'
+	  if(.not.present(stat)) call die(myname_)
+	  stat=1
+	  return
+        endif
+        istp=3
+
+      case default
+
+        write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+        if(.not.present(stat)) call die(myname_)
+        stat=2
+        return
+
+      end select	  ! case(c1//c2)
+    end select		! case(c1)
+	!________________________________________
+
+    select case(c1)
+
+    case("y")
+      select case(c2)
+      case("2")
+	write(sbuf,'(i2.2)') iy2
+	kstp=2
+      case("4")
+	write(sbuf,'(i4.4)') iy4
+	kstp=4
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case("m")
+      select case(c2)
+      case("1")
+	if(imo < 10) then
+	  write(sbuf,'(i1)') imo
+	  kstp=1
+	else
+	  write(sbuf,'(i2)') imo
+	  kstp=2
+	endif
+      case("2")
+	write(sbuf,'(i2.2)') imo
+	kstp=2
+      case("c")
+	sbuf=mon_lc(imo)
+	kstp=3
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case("M")
+      select case(c2)
+      case("c")
+	sbuf=mon_wd(imo)
+	kstp=3
+      case("C")
+	sbuf=mon_uc(imo)
+	kstp=3
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case("d")
+      select case(c2)
+      case("1")
+	if(idy < 10) then
+	  write(sbuf,'(i1)') idy
+	  kstp=1
+	else
+	  write(sbuf,'(i2)') idy
+	  kstp=2
+	endif
+      case("2")
+	write(sbuf,'(i2.2)') idy
+	kstp=2
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case("h")
+      select case(c2)
+      case("1")
+	if(ihr < 10) then
+	  write(sbuf,'(i1)') ihr
+	  kstp=1
+	else
+	  write(sbuf,'(i2)') ihr
+	  kstp=2
+	endif
+      case("2")
+	write(sbuf,'(i2.2)') ihr
+	kstp=2
+      case("3")
+	write(sbuf,'(i3.3)') ihr
+	kstp=3
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case("n")
+      select case(c2)
+      case("2")
+	write(sbuf,'(i2.2)') imn
+	kstp=2
+      case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+	return
+      end select
+
+    case default
+	write(stderr,'(4a)') myname_,	&
+	  ': invalid template entry:  ',trim(tmpl(i:)),'.'
+	if(.not.present(stat)) call die(myname_)
+	stat=2
+      return
+    end select	! case(c1)
+
+    m=min(k+kstp-1,ln_Str)
+    str(k:m)=sbuf
+    k=m+1
+
+  case default
+
+    istp=1
+    str(k:k)=tmpl(i:i)
+    k=k+1
+
+  end select	! case(c0)
+end do
+
+end subroutine GX_
+end module m_StrTemplate
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_String.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_String.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_String.F90	(revision 4775)
@@ -0,0 +1,831 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_String.F90,v 1.8 2007-11-06 00:03:32 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_String - The String Datatype
+!
+! !DESCRIPTION:
+! The {\tt String} datatype is an encapsulated pointer to a one-dimensional
+! array of single characters.  This allows one to define variable-length
+! strings, and arrays of variable-length strings.
+!
+! !INTERFACE:
+
+ module m_String
+
+! !USES:
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private	! except
+
+! !PUBLIC TYPES:
+
+      public :: String		! The class data structure
+
+    Type String
+#ifdef SEQUENCE
+      sequence
+#endif
+      character(len=1),dimension(:),pointer :: c
+    End Type String
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: toChar		
+      public :: char		! convert to a CHARACTER(*)
+
+      public :: String_init
+      public :: init		! set a CHARACTER(*) type to a String
+
+      public :: String_clean
+      public :: clean		! Deallocate memory occupied by  a String
+
+      public :: String_len
+      public :: len		! length of a String
+
+      public :: String_bcast
+      public :: bcast		! Broadcast a String
+
+      public :: String_mci      ! Track memory used to store a String
+      public :: String_mco
+
+      public :: ptr_chars       ! Assign a pointer to a String's
+                                ! character buffer
+
+  interface char;  module procedure	&
+	str2ch0_,	&
+	ch12ch0_
+  end interface
+
+  interface toChar;  module procedure	&
+	str2ch0_,	&
+	ch12ch0_
+  end interface
+
+  interface String_init;  module procedure	&
+	initc_,		&
+	initc1_,	&
+	inits_
+  end interface
+
+  interface init;  module procedure	&
+	initc_,		&
+	initc1_,	&
+	inits_
+  end interface
+
+  interface String_clean; module procedure clean_; end interface
+  interface clean; module procedure clean_; end interface
+  interface String_len; module procedure len_; end interface
+  interface len; module procedure len_; end interface
+  interface String_bcast; module procedure bcast_; end interface
+  interface bcast; module procedure bcast_; end interface
+
+  interface String_mci; module procedure	&
+    mci0_,	&
+    mci1_,	&
+    mci2_,	&
+    mci3_
+  end interface
+
+  interface String_mco; module procedure	&
+    mco0_,	&
+    mco1_,	&
+    mco2_,	&
+    mco3_
+  end interface
+
+  interface ptr_chars; module procedure	&
+    ptr_chars_
+  end interface
+
+! !REVISION HISTORY:
+! 	22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_String'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: str2ch0_ - Convert a String to a CHARACTER
+!
+! !DESCRIPTION:
+! This function returns the contents of the character buffer of the 
+! input {\tt String} argument {\tt str} as a {\tt CHARCTER} suitable 
+! for printing.
+!
+! !INTERFACE:
+
+ function str2ch0_(str)
+
+! !USES:
+!
+! No external modules are used by this function.
+
+     implicit none
+
+! !INPUT PARAMETERS: 
+!
+     type(String),              intent(in) :: str
+
+! !OUTPUT PARAMETERS: 
+!
+     character(len=size(str%c,1))            :: str2ch0_
+
+! !REVISION HISTORY:
+! 	23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::str2ch0_'
+  integer :: i
+
+  do i=1,size(str%c)
+    str2ch0_(i:i)=str%c(i)
+  end do
+
+ end function str2ch0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ch12ch0_ - Convert a CHARACTER(:) to a CHARACTER(*)
+!
+! !DESCRIPTION:
+! This function takes an input one-dimensional array of single characters
+! and returns a single character string.
+!
+! !INTERFACE:
+
+ function ch12ch0_(ch1)
+
+! !USES:
+!
+! No external modules are used by this function.
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=1), dimension(:), intent(in) :: ch1
+
+! !OUTPUT PARAMETERS: 
+!
+      character(len=size(ch1,1))                   :: ch12ch0_
+
+! !REVISION HISTORY:
+! 	22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ch12ch0_'
+  integer :: i
+
+  do i=1,size(ch1)
+    ch12ch0_(i:i)=ch1(i)
+  end do
+
+ end function ch12ch0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initc_ - Create a String using a CHARACTER
+!
+! !DESCRIPTION:
+! This routine takes an input scalar {\tt CHARACTER} argument {\tt chr}, 
+! and uses it to create the output {\tt String} argument {\tt str}.
+!
+! !INTERFACE:
+
+ subroutine initc_(str, chr)
+
+! !USES:
+!
+      use m_die, only : die,perr
+      use m_mall,only : mall_mci,mall_ison
+ 
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character(len=*), intent(in)  :: chr
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),     intent(out) :: str
+
+! !REVISION HISTORY:
+! 	23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initc_'
+  integer :: ln,ier,i
+
+  ln=len(chr)
+  allocate(str%c(ln),stat=ier)
+  if(ier /= 0) then
+    call perr(myname_,'allocate()',ier)
+    call die(myname_)
+  endif
+
+	if(mall_ison()) call mall_mci(str%c,myname)
+
+  do i=1,ln
+    str%c(i)=chr(i:i)
+  end do
+
+ end subroutine initc_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: initc1_ - Create a String using a CHARACTER array
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt CHARACTER(:)} argument {\tt chr}, 
+! and uses it to create the output {\tt String} argument {\tt str}.
+!
+! !INTERFACE:
+
+ subroutine initc1_(str, chr)
+
+! !USES:
+!
+      use m_die, only : die,perr
+      use m_mall,only : mall_mci,mall_ison
+ 
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      character,     dimension(:), intent(in)  :: chr
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),                intent(out) :: str
+
+! !REVISION HISTORY:
+!  2Aug02 - J. Larson <larson@mcs.anl.gov> - initial prototype
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::initc1_'
+  integer :: ln,ier,i
+
+  ln=size(chr)
+  allocate(str%c(ln),stat=ier)
+  if(ier /= 0) then
+    call perr(myname_,'allocate()',ier)
+    call die(myname_)
+  endif
+
+	if(mall_ison()) call mall_mci(str%c,myname)
+
+  do i=1,ln
+    str%c(i)=chr(i)
+  end do
+
+ end subroutine initc1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: inits_ - Initialization of a String from another String
+!
+! !DESCRIPTION:
+! This routine takes an input {\tt String} argument {\tt iStr} and 
+! creates an output {\tt String} argument {\tt oStr}.  In other words,
+! it copies {\tt iStr} to {\tt oStr}.
+!
+! !INTERFACE:
+
+ subroutine inits_(oStr, iStr)
+ 
+! !USES:
+!
+      use m_die, only : die
+      use m_mall,only : mall_mci,mall_ison
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),  intent(in)  :: iStr
+
+! !OUTPUT PARAMETERS: 
+!
+      type(String),  intent(out) :: oStr
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::inits_'
+  integer :: ln,ier,i
+
+  ln=size(iStr%c)
+
+	allocate(oStr%c(ln),stat=ier)
+		if(ier /= 0) call die(myname_,'allocate()',ier)
+
+	if(mall_ison()) call mall_mci(oStr%c,myname)
+
+  do i=1,ln
+    oStr%c(i)=iStr%c(i)
+  end do
+
+ end subroutine inits_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - Deallocate Memory Occupied by a String
+!
+! !DESCRIPTION:
+! This routine deallocates memory associated with the input/output 
+! {\tt String} argument {\tt str}.  This amounts to deallocating 
+! {\tt str\%c}.
+!
+! !INTERFACE:
+
+ subroutine clean_(str)
+
+! !USES:
+!
+      use m_die, only : die,perr
+      use m_mall,only : mall_mco,mall_ison
+
+      implicit none
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(String), intent(inout) :: str
+
+! !REVISION HISTORY:
+! 	23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+
+	if(mall_ison()) call mall_mco(str%c,myname)
+
+  deallocate(str%c,stat=ier)
+  if(ier /= 0) then
+    call perr(myname_,'deallocate()',ier)
+    call die(myname_)
+  endif
+
+ end subroutine clean_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: bcast_ - MPI Broadcast of a rank-0 String
+!
+! !DESCRIPTION:
+! This routine performs an MPI broadcast of the input/output {\tt String}
+! argument {\tt Str} on a communicator associated with the Fortran integer
+! handle {\tt comm}.  The broadcast originates from the process with rank
+! given by {\tt root} on {\tt comm}.  The {\tt String} argument {\tt Str} 
+! is on entry valid only on the {\tt root} process, and is valid on exit
+! on all processes on the communicator {\tt comm}.  The success (failure) 
+! is signified by a zero (non-zero) value of the optional {\tt INTEGER} 
+! output argument {\tt stat}.
+!
+! !INTERFACE:
+
+ subroutine bcast_(Str, root, comm, stat)
+
+! !USES:
+!
+      use m_mpif90
+      use m_die, only : perr,die
+      use m_mall,only : mall_mci,mall_ison
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      integer,           intent(in)    :: root
+      integer,           intent(in)    :: comm
+
+! !INPUT/OUTPUT PARAMETERS: 
+!
+      type(String),      intent(inout) :: Str ! (IN) on the root, 
+                                              ! (OUT) elsewhere
+
+! !OUTPUT PARAMETERS: 
+!
+      integer, optional, intent(out)   :: stat
+
+! !REVISION HISTORY:
+! 	27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::bcast_'
+  integer :: ln,ier,myID
+
+  if(present(stat)) stat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) then
+    call MP_perr(myname_,'MP_comm_rank()',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+  if(myID==root) then
+     ln=size(Str%c)
+     if(ln<=0) call die(myname_,'size(Str%c) <= 0')
+  endif
+
+  call MPI_bcast(ln,1,MP_INTEGER,root,comm,ier)
+  if(ier/=0) then
+    call MP_perr(myname_,'MPI_bcast(ln)',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+  if(myID /= root) then
+
+    allocate(Str%c(ln),stat=ier)
+    if(ier /= 0) then
+      call perr(myname_,'allocate()',ier)
+      if(.not.present(stat)) call die(myname_)
+      stat=ier
+      return
+    endif
+
+	if(mall_ison()) call mall_mci(Str%c,myname)
+  endif
+
+  call MPI_bcast(Str%c(1),ln,MP_CHARACTER,root,comm,ier)
+  if(ier/=0) then
+    call MP_perr(myname_,'MPI_bcast(Str%c)',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+ end subroutine bcast_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mci0_ - checking in a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mci0_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_ci
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     intent(in) :: marg
+      character(len=*), intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mci0_'
+
+  call mall_ci(1,thread)
+
+ end subroutine mci0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mco0_ - checking out a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mco0_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_co
+
+      implicit none
+
+      type(String),    intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mco0_'
+
+  call mall_co(1,thread)
+
+ end subroutine mco0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mci1_ - checking in a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mci1_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_ci
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:), intent(in) :: marg
+      character(len=*),               intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mci1_'
+
+  call mall_ci(size(marg),thread)
+
+ end subroutine mci1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mco1_ - checking out a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mco1_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_co
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:), intent(in) :: marg
+      character(len=*),               intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mco1_'
+
+  call mall_co(size(marg),thread)
+
+ end subroutine mco1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mci2_ - checking in a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mci2_(marg, thread)
+
+! !USES:
+!
+      use m_mall, only : mall_ci
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:,:), intent(in) :: marg
+      character(len=*),                 intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mci2_'
+
+  call mall_ci(size(marg),thread)
+
+ end subroutine mci2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mco2_ - checking out a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mco2_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_co
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:,:), intent(in) :: marg
+      character(len=*),                 intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mco2_'
+
+  call mall_co(size(marg),thread)
+
+ end subroutine mco2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mci3_ - checking in a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mci3_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_ci
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:,:,:), intent(in) :: marg
+      character(len=*),                   intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mci3_'
+
+  call mall_ci(size(marg),thread)
+
+ end subroutine mci3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: mco3_ - checking out a String scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ subroutine mco3_(marg,thread)
+
+! !USES:
+!
+      use m_mall, only : mall_co
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),     dimension(:,:,:), intent(in) :: marg
+      character(len=*),                   intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	07Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::mco3_'
+
+  call mall_co(size(marg),thread)
+
+  end subroutine mco3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: len_ = len of a String
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+ integer function len_(str)
+
+! !USES:
+!
+! No external modules are used by this function.
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),intent(in) :: str
+
+! !REVISION HISTORY:
+! 	10Apr00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::len_'
+
+  len_=size(str%c)
+
+ end function len_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ptr_chars_ - direct
+!
+! !DESCRIPTION:
+! This pointer-valued function provides a direct interface to the 
+! character buffer in the input {\tt String} argument {\tt str}.  That 
+! is, {\tt ptr\_chars\_ => str\%c}.
+!
+! !INTERFACE:
+
+ function ptr_chars_(str)
+
+! !USES:
+!
+! No external modules are used by this function.
+
+      implicit none
+
+! !INPUT PARAMETERS: 
+!
+      type(String),                   intent(in) :: str
+
+! !OUTPUT PARAMETERS: 
+!
+      character(len=1), dimension(:), pointer    :: ptr_chars_
+
+! !REVISION HISTORY:
+! 	10Apr00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ptr_chars_'
+
+  ptr_chars_ => str%c
+
+ end function ptr_chars_
+
+ end module m_String
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StringLinkedList.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StringLinkedList.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_StringLinkedList.F90	(revision 4775)
@@ -0,0 +1,553 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_StringLinkedList - A linked-list of String
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_StringLinkedList
+      use m_String,only : String
+      implicit none
+      private	! except
+
+      public :: StringLinkedList	! The class data structure
+
+		! o An object of a StringLinkedList should be defined
+		!   as a pointer of a StringLinkedList.  It is often
+		!   represented by a pointer to the head-node of the
+		!   linked-list.
+		!
+		! o A node in a StringLinkedList is specificed by a
+		!   reference pointer.  A reference pointer is a
+		!   logical reference of a node in the list.  However,
+		!   it does not physically point to that node.  In
+		!   fact, a reference pointer normally references to
+		!   the node physically pointed by the pointer in the
+		!   node physically pointed by the reference pointer,
+		!
+		!	[this] -> [..|next] -> [..|next]
+		!
+		!   where the last node is the logically referenced
+		!   node.
+
+      public :: StringLinkedList_init	! constructor
+      public :: StringLinkedList_clean  ! destructor
+
+		! A _clean() action will reset a StringLinkedList to its
+		! pre-_init() status.
+
+      public :: StringLinkedList_insert ! grower, insert a node
+      public :: StringLinkedList_delete ! ungrower, delete a node
+
+		! Both procedures processing the node through a given
+		! reference pointer.  The reference pointer will not
+		! be modified directly through either _insert() or
+		! _delete().  It is the pointer in the node physically
+		! pointed by a reference pointer got modified.  Also,
+		! the node logically referenced by the reference
+		! pointer is either the new node for an _insert(), and
+		! the removed node for a _delete().
+
+      public :: StringLinkedList_eol	! inquirer, is an end-node?
+
+		! An end-of-list situation occurs when the reference
+		! pointer is logically referencing to the end-node or
+		! beyond.  Note that an end-node links to itself.
+
+      public :: StringLinkedList_next	! iterator, go to the next node.
+
+      public :: StringLinkedList_count	! counter
+      
+		! Count the number of nodes from this reference pointer,
+		! starting from and including the logical node but
+		! excluding the end-node.
+
+      public :: StringLinkedList_get	! fetcher
+
+		! Get the value logically referenced by a reference
+		! pointer.  Return EOL if the referenced node is an
+		! EOL().  The reference pointer will be iterated to
+		! the next node if the referenced node is not an EOL.
+
+    type StringLinkedList
+      type(String) :: str
+      type(StringLinkedList),pointer :: next
+    end type StringLinkedList
+
+    interface StringLinkedList_init  ; module procedure	&
+	init_
+    end interface
+
+    interface StringLinkedList_clean ; module procedure	&
+	clean_
+    end interface
+
+    interface StringLinkedList_insert; module procedure	&
+	insertc_,	&	! insert a CHARACTER(len=*) argument
+	inserts_		! insert a String argument
+    end interface
+
+    interface StringLinkedList_delete; module procedure	&
+	delete_
+    end interface
+
+    interface StringLinkedList_eol   ; module procedure	&
+	eol_
+    end interface
+
+    interface StringLinkedList_next  ; module procedure	&
+	next_
+    end interface
+
+    interface StringLinkedList_count ; module procedure	&
+	count_
+    end interface
+
+    interface StringLinkedList_get   ; module procedure	&
+	getc_,		&	! get as a CHARACTER(len=*)
+	gets_			! get as a String
+    end interface
+
+! !REVISION HISTORY:
+! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_StringLinkedList'
+
+!   Examples:
+!
+!   1) Creating a first-in-first-out linked-list,
+!
+!	type(StringLinkedList),pointer :: head,this
+!	character(len=80) :: aline
+!
+!	call StringLinkedList_init(head)
+!	this => head
+!	do
+!	  read(*,'(a)',iostat=ier) aline
+!	  if(ier/=0) exit
+!	  call StringLinkedList_insert(trim(aline),this)
+!	  call StringLinkedList_next(this)
+!	end do
+!
+!   2) Creating a last-in-first-out linked-list,  Note that the only
+!     difference from Example (1) is without a call to
+!     StringLinkedList_next().
+!
+!	type(StringLinkedList),pointer :: head,this
+!	character(len=80) :: aline
+!
+!	call StringLinkedList_init(head)
+!	this => head
+!	do
+!	  read(*,'(a)',iostat=ier) aline
+!	  if(ier/=0) exit
+!	  call StringLinkedList_insert(trim(aline),this)
+!	end do
+!
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: init_ - initialize a StringLinkedList from a pointer
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine init_(head)
+      use m_die, only : die
+      use m_mall,only : mall_ison,mall_ci
+      implicit none
+      type(StringLinkedList),pointer :: head	! (out) a list
+
+! !REVISION HISTORY:
+! 	22Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::init_'
+  type(StringLinkedList),pointer :: tail
+  integer :: ier
+
+	! Two special nodes are needed for a linked-list, according to
+	! Robert Sedgewick (Algorithms, QA76.6.S435, page 21).
+	!
+	! It seems only _head_ will be needed for external references.
+	! Node _tail_ will be used to denote an end-node.
+
+  allocate(head,tail,stat=ier)
+	if(ier/=0) call die(myname_,'allocate()',ier)
+
+	if(mall_ison()) call mall_ci(2,myname)	! for two nodes
+
+  head%next => tail
+  tail%next => tail
+
+  nullify(tail)
+
+end subroutine init_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: insertc_ - insert before the logically referenced node
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine insertc_(cstr,this)
+      use m_String,only : String_init
+      use m_mall,  only : mall_ison,mall_ci
+      use m_die,   only : die
+      implicit none
+      character(len=*),intent(in) :: cstr ! a new entry
+      type(StringLinkedList),pointer :: this ! (in) a node
+
+! !REVISION HISTORY:
+! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::insertc_'
+  type(StringLinkedList),pointer :: tmpl
+  integer :: ier
+
+	! Create a memory cell for the new entry of StringLinkedList
+
+  allocate(tmpl,stat=ier)
+	if(ier/=0) call die(myname_,'allocate()',ier)
+
+	if(mall_ison()) call mall_ci(1,myname)	! for one nodes
+
+	! Store the data
+
+  call String_init(tmpl%str,cstr)
+
+	! Rebuild the links, if the List was not empty
+
+  tmpl%next => this%next
+  this%next => tmpl
+
+	! Clean the working pointer
+
+  nullify(tmpl)
+
+end subroutine insertc_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: inserts_ - insert before the logically referenced node
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine inserts_(str,this)
+      use m_String,only : String,String_init
+      use m_mall,  only : mall_ison,mall_ci
+      use m_die,   only : die
+      implicit none
+      type(String),intent(in)  :: str	! a new entry
+      type(StringLinkedList),pointer :: this ! (in) a node
+
+! !REVISION HISTORY:
+! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::inserts_'
+  type(StringLinkedList),pointer :: tmpl
+  integer :: ier
+
+	! Create a memory cell for the new entry of StringLinkedList
+
+  allocate(tmpl,stat=ier)
+	if(ier/=0) call die(myname_,'allocate()',ier)
+
+	if(mall_ison()) call mall_ci(1,myname)	! for one nodes
+
+	! Store the data
+
+  call String_init(tmpl%str,str)
+
+	! Rebuild the links, if the List was not empty
+
+  tmpl%next => this%next
+  this%next => tmpl
+
+	! Clean the working pointer, if it mean anyting
+
+  nullify(tmpl)
+
+end subroutine inserts_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: delete_ - delete the logically referenced node
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine delete_(this)
+      use m_String,only : String_clean
+      use m_mall,  only : mall_ison,mall_co
+      use m_die,   only : die
+      implicit none
+      type(StringLinkedList),pointer :: this ! (in) a node
+
+! !REVISION HISTORY:
+! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::delete_'
+  type(StringLinkedList),pointer :: tmpl
+  integer :: ier
+
+  tmpl => this%next%next		! hold the next target
+  call String_clean(this%next%str)	! remove the next storage
+
+	if(mall_ison()) call mall_co(1,myname)	! removing one node
+
+  deallocate(this%next,stat=ier)	! Clean memory gabage
+	if(ier/=0) call die(myname_,'deallocate()',ier)
+
+	! Skip the current target.  Rebuild the link to the target
+	! of the current target.
+
+  this%next => tmpl
+
+	! Clean the working pointer, if it mean anything
+
+  nullify(tmpl)
+end subroutine delete_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: eol_ - if the logically referenced node is an end-node
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function eol_(this)
+      implicit none
+      type(StringLinkedList),pointer :: this ! (in) a node
+      logical :: eol_		! returned value
+
+! !REVISION HISTORY:
+! 	23Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::eol_'
+
+  eol_=associated(this%next,this%next%next)
+end function eol_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: next_ - point a reference pointer to the next node
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine next_(this)
+      implicit none
+      type(StringLinkedList),pointer :: this ! (inout) a node
+
+! !REVISION HISTORY:
+! 	23Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::next_'
+
+  this => this%next
+
+end subroutine next_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: count_ - count the number of nodes
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function count_(this)
+      implicit none
+      type(StringLinkedList),pointer :: this ! (in) a node
+      integer :: count_		! returned value
+
+! !REVISION HISTORY:
+! 	24Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::count_'
+  type(StringLinkedList),pointer :: tmpl
+
+  tmpl => this
+
+  count_=0
+  do while(.not.eol_(tmpl))
+    count_=count_+1
+    call next_(tmpl)
+  end do
+
+  nullify(tmpl)
+end function count_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: getc_ - get the logically referenced value as CHARACTERs
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine getc_(this,cstr,eol)
+      use m_String,only : String
+      use m_String,only : String_init
+      use m_String,only : String_clean
+      use m_String,only : char
+      implicit none
+      type(StringLinkedList),pointer :: this ! (inout) a node
+      character(len=*),intent(out) :: cstr ! the referenced value
+      logical         ,intent(out) :: eol  ! if the node is an end-node
+
+! !REVISION HISTORY:
+! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::getc_'
+  type(String) :: str
+
+  call gets_(this,str,eol)
+
+  if(.not.eol) then
+    cstr=char(str)
+    call String_clean(str)
+  endif
+
+end subroutine getc_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: gets_ - get the logically referenced value as a String
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine gets_(this,str,eol)
+      use m_String,only : String
+      use m_String,only : String_init
+      implicit none
+      type(StringLinkedList),pointer :: this ! (inout) a node
+      type(String),intent(out) :: str  ! the referenced value
+      logical     ,intent(out) :: eol  ! if the node is an end-node
+
+! !REVISION HISTORY:
+! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::gets_'
+
+  eol=eol_(this)
+  if(.not.eol) then
+    call String_init(str,this%next%str)
+    call next_(this)
+  endif
+
+end subroutine gets_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: clean_ - clean the whole object from this point
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine clean_(head,stat)
+      use m_die,only : die,perr
+      use m_mall,only : mall_ison,mall_co
+      implicit none
+      type(StringLinkedList),pointer :: head ! (inout) a head-node
+      integer,optional,intent(out) :: stat ! return status
+
+! !REVISION HISTORY:
+! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::clean_'
+  integer :: ier
+  logical :: err
+
+  if(present(stat)) stat=0
+
+	! Verify if the pointer is valid
+
+  err=.not.associated(head)
+  if(.not.err) err=.not.associated(head%next)
+
+	if(err) then
+	  call perr(myname_,'Attempting to clean an uninitialized list')
+	  if(.not.present(stat)) call die(myname_)
+	  stat=-1
+	  return
+	endif
+
+	! Clean the rest before delete the current one.
+
+  do
+    if(eol_(head)) exit
+    call delete_(head)
+  end do
+
+	if(mall_ison()) call mall_co(2,myname)	! remove two nodes
+
+  deallocate(head%next,stat=ier)
+  if(ier==0) deallocate(head,stat=ier)
+	if(ier/=0) then
+	  call perr(myname_,'deallocate()',ier)
+	  if(.not.present(stat)) call die(myname_)
+	  stat=-1
+	  return
+	endif
+
+end subroutine clean_
+
+end module m_StringLinkedList
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_TraceBack.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_TraceBack.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_TraceBack.F90	(revision 4775)
@@ -0,0 +1,240 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!-----------------------------------------------------------------------
+! CVS m_TraceBack.F90,v 1.3 2004-04-21 22:54:46 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_TraceBack - Generation of Traceback Information
+!
+! !DESCRIPTION:
+! This module supports the generation of traceback information for 
+! a given routine.  
+! 
+!
+! !INTERFACE:
+
+ module m_TraceBack
+
+! !USES:
+! No external modules are used in the declaration section of this module.
+
+      implicit none
+
+      private   ! except
+
+! !PUBLIC TYPES:
+! No public types are declared in this module.
+
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+      public :: GenTraceBackString
+
+      interface GenTraceBackString; module procedure &
+	 GenTraceBackString1, &
+	 GenTraceBackString2
+      end interface
+
+! !PUBLIC DATA MEMBERS:
+! No public data member constants are declared in this module.
+
+
+! !REVISION HISTORY:
+!  5 Aug02 - J. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+! Parameters local to this module:
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_TraceBackString'
+
+  character(len=len('|X|')), parameter :: StartChar = '|X|'
+  character(len=len('->')), parameter :: ArrowChar = '->'
+
+ contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GenTraceBackString1 - Start a TraceBack with One Routine Name
+!
+! !DESCRIPTION:
+! This routine takes in CHARACTER form the names of the calling routine
+! (the input argument {\tt RoutineName} and returns a {\tt String} 
+! (the output argument {\tt TraceBackString}) that portrays this routine
+! as the starting point of a downwards procedural trace.  The contents 
+! of {\tt TraceBackString} is merely an {\tt '|X|'}, followed immediately 
+! by the value of {\tt RoutineName}.
+!
+! !INTERFACE:
+
+ subroutine GenTraceBackString1(TraceBackString, RoutineName)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*), intent(in)  :: RoutineName
+
+! !OUTPUT PARAMETERS:
+!
+      type(String),     intent(out) :: TraceBackString
+
+! !REVISION HISTORY:
+!  5Aug02 - J. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GenTraceBackString1'
+  integer :: i, ierr
+  integer :: RoutineNameLength, ScratchBufferLength
+  character, dimension(:), allocatable :: ScratchBuffer
+
+       ! Note:  The value of ArrowChar is inherited
+       ! from the declaration section of this module.
+
+       ! Determine the lengths of ParentName and ChildName
+
+  RoutineNameLength = len(RoutineName)
+
+       ! Set up ScratchBuffer:
+
+  ScratchBufferLength = len(StartChar) + RoutineNameLength
+                        
+  allocate(ScratchBuffer(ScratchBufferLength), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Allocate(ScratchBuffer...) failed.  ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load ScratchBuffer:
+
+
+  do i=1,len(StartChar) ! Load the '|X|'...
+     ScratchBuffer(i) = StartChar(i:i)
+  end do
+
+  do i=1,RoutineNameLength
+     ScratchBuffer(len(StartChar)+i) = RoutineName(i:i)
+  end do
+
+       ! Create TraceBackString
+
+  call String_init(TraceBackString, ScratchBuffer)
+
+       ! Clean up:
+
+  deallocate(ScratchBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Deallocate(ScratchBuffer...) failed.  ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine GenTraceBackString1
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!    Math and Computer Science Division, Argonne National Laboratory   !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: GenTraceBackString2 - Connect Two Routine Names in a TraceBack
+!
+! !DESCRIPTION:
+! This routine takes in CHARACTER form the names of the parent and 
+! child routines (the input arguments {\tt ParentName} and 
+! {\tt ChildName}, repsectively), and returns a {\tt String} (the output 
+! argument {\tt TraceBackString}) that portrays their procedural 
+! relationship.  The contents of {\tt TraceBackString} is merely 
+! {\tt ParentName}, followe by an arrow ({\tt "->"}), followed by
+! {\tt ChildName}.
+!
+! !INTERFACE:
+
+ subroutine GenTraceBackString2(TraceBackString, ParentName, ChildName)
+!
+! !USES:
+!
+      use m_stdio
+      use m_die
+
+      use m_String, only : String
+      use m_String, only : String_init => init
+      
+      implicit none
+
+! !INPUT PARAMETERS:
+!
+      character(len=*), intent(in)  :: ParentName
+      character(len=*), intent(in)  :: ChildName
+
+! !OUTPUT PARAMETERS:
+!
+      type(String),     intent(out) :: TraceBackString
+
+! !REVISION HISTORY:
+!  5Aug02 - J. Larson <larson@mcs.anl.gov> - Initial version.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::GenTraceBackString2'
+  integer :: i, ierr
+  integer :: ParentNameLength, ChildNameLength, ScratchBufferLength
+  character, dimension(:), allocatable :: ScratchBuffer
+
+       ! Note:  The value of ArrowChar is inherited
+       ! from the declaration section of this module.
+
+       ! Determine the lengths of ParentName and ChildName
+
+  ParentNameLength = len(ParentName)
+  ChildNameLength = len(ChildName)
+
+       ! Set up ScratchBuffer:
+
+  ScratchBufferLength = ParentNameLength + ChildNameLength + &
+                        len(ArrowChar)
+  allocate(ScratchBuffer(ScratchBufferLength), stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Allocate(ScratchBuffer...) failed.  ierr = ',ierr
+     call die(myname_)
+  endif
+
+       ! Load ScratchBuffer:
+
+  do i=1,ParentNameLength ! Load the Parent Routine Name...
+     ScratchBuffer(i) = ParentName(i:i)
+  end do
+
+  do i=1,len(ArrowChar) ! Load the Arrow...
+     ScratchBuffer(ParentNameLength+i) = ArrowChar(i:i)
+  end do
+
+  do i=1,ChildNameLength
+     ScratchBuffer(ParentNameLength+len(ArrowChar)+i) = ChildName(i:i)
+  end do
+
+       ! Create TraceBackString
+
+  call String_init(TraceBackString, ScratchBuffer)
+
+       ! Clean up:
+
+  deallocate(ScratchBuffer, stat=ierr)
+  if(ierr /= 0) then
+     write(stderr,'(2a,i8)') myname_, &
+	  ':: Deallocate(ScratchBuffer...) failed.  ierr = ',ierr
+     call die(myname_)
+  endif
+
+ end subroutine GenTraceBackString2
+
+ end module m_TraceBack
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_chars.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_chars.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_chars.F90	(revision 4775)
@@ -0,0 +1,107 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_chars.F90,v 1.3 2004-04-21 22:54:46 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_chars - a module for character class object operations
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+	module m_chars
+	implicit none
+	private
+
+	public	:: operator (.upper.)	! convert a string to uppercase
+	public	:: uppercase
+
+	public	:: operator (.lower.)	! convert a string to lowercase
+	public	:: lowercase
+
+	interface operator (.upper.)
+	  module procedure upper_case
+	end interface
+	interface uppercase
+	  module procedure upper_case
+	end interface
+
+	interface operator (.lower.)
+	  module procedure lower_case
+	end interface
+	interface lowercase
+	  module procedure lower_case
+	end interface
+
+! !REVISION HISTORY:
+! 	16Jul96 - J. Guo	- (to do)
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_chars'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: upper_case - convert lowercase letters to uppercase.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+  function upper_case(str) result(ustr)
+    implicit none
+  character(len=*), intent(in) :: str
+  character(len=len(str))      :: ustr
+
+! !REVISION HISTORY:
+! 	13Aug96 - J. Guo	- (to do)
+!EOP
+!_______________________________________________________________________
+    integer i
+    integer,parameter :: il2u=ichar('A')-ichar('a')
+
+    ustr=str
+    do i=1,len_trim(str)
+      if(str(i:i).ge.'a'.and.str(i:i).le.'z')	&
+      	ustr(i:i)=char(ichar(str(i:i))+il2u)
+    end do
+  end function upper_case
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: lower_case - convert uppercase letters to lowercase.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+  function lower_case(str) result(lstr)
+    implicit none
+    character(len=*), intent(in) :: str
+    character(len=len(str))      :: lstr
+
+! !REVISION HISTORY:
+! 	13Aug96 - J. Guo	- (to do)
+!EOP
+!_______________________________________________________________________
+    integer i
+    integer,parameter :: iu2l=ichar('a')-ichar('A')
+
+    lstr=str
+    do i=1,len_trim(str)
+      if(str(i:i).ge.'A'.and.str(i:i).le.'Z')	&
+      	lstr(i:i)=char(ichar(str(i:i))+iu2l)
+    end do
+  end function lower_case
+
+end module m_chars
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_die.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_die.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_die.F90	(revision 4775)
@@ -0,0 +1,404 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_die.F90,v 1.4 2004-04-21 22:54:47 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_die - die with mpout flushed
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_die
+      use m_mpif90, only : MP_perr
+      implicit none
+      private	! except
+
+      public :: die		! signal an exception
+      public :: diex		! a special die() supporting macros
+      public :: perr,warn	! message(s) to stderr
+      public :: perr_die	! to be phased out
+      public :: MP_die		! a special die() for MPI errors
+      public :: MP_perr		! perr for MPI errors, from m_mpif90
+      public :: MP_perr_die	! a special die() for MPI errors
+      public :: assert_		! used by ASSERT() macro of assert.H
+
+      interface die; module procedure	&
+	die0_,	& ! die(where)
+	die1_,	& ! die(where,message)
+	die2_,	& ! die(where,proc,ier)
+	die4_	  ! die(where,mesg1,ival1,mesg2,ival2)
+      end interface
+
+      interface diex; module procedure	&
+	diex_	  ! diex(where,filename,lineno)
+      end interface
+
+      interface perr; module procedure	&
+	perr1_,	& ! perr(where,message)
+	perr2_,	& ! perr(where,proc,ier)
+	perr4_	  ! perr(where,mesg1,ival1,mesg2,ival2)
+      end interface
+      interface warn; module procedure	&
+	perr1_,	& ! perr(where,message)
+	perr2_,	& ! perr(where,proc,ier)
+	perr4_	  ! perr(where,mesg1,ival1,mesg2,ival2)
+      end interface
+
+      interface perr_die; module procedure	&
+	die2_	  ! perr_die(where,proc,ier)
+      end interface
+
+      interface MP_die; module procedure	&
+	MPdie2_	  ! MP_die(where,proc,ier)
+      end interface
+      interface MP_perr_die; module procedure	&
+	MPdie2_	  ! MP_die(where,proc,ier)
+      end interface
+
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_die'
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: die0_ - flush(mpout) before die()
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine die0_(where)
+      use m_mpout, only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow, only : flow_flush
+      use m_dropdead, only : ddie => die
+      implicit none
+      character(len=*),intent(in) :: where
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::die0_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+  call ddie(where)
+
+end subroutine die0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: die1_ - flush(mpout) before die()
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine die1_(where,message)
+      use m_mpout, only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow, only : flow_flush
+      use m_dropdead, only : ddie => die
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: message
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::die1_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+
+  call perr1_(where,message)
+  call ddie(where)
+
+end subroutine die1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: die2_ - flush(mpout) before die()
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine die2_(where,proc,ier)
+      use m_mpout, only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow, only : flow_flush
+      use m_dropdead, only : ddie => die
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: proc
+      integer,intent(in) :: ier
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::die2_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+
+  call perr2_(where,proc,ier)
+  call ddie(where)
+
+end subroutine die2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: die4_ - flush(mpout) before die()
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine die4_(where,mesg1,ival1,mesg2,ival2)
+      use m_mpout, only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow, only : flow_flush
+      use m_dropdead, only : ddie => die
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: mesg1
+      integer,intent(in) :: ival1
+      character(len=*),intent(in) :: mesg2
+      integer,intent(in) :: ival2
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::die4_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+
+  call perr4_(where,mesg1,ival1,mesg2,ival2)
+  call ddie(where)
+
+end subroutine die4_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: diex_ - flush(mpout) before die()
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine diex_(where,filename,line)
+      use m_mpout, only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow, only : flow_flush
+      use m_dropdead, only : ddie => die
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: filename
+      integer,intent(in) :: line
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::diex_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+  call ddie(where,filename,line)
+
+end subroutine diex_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: perr1_ - send a simple error message to _stderr_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine perr1_(where,message)
+      use m_stdio,only : stderr
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: message
+
+! !REVISION HISTORY:
+! 	27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::perr1_'
+
+  write(stderr,'(3a)') where,': ',message
+
+end subroutine perr1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: perr2_ - send a simple error message to _stderr_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine perr2_(where,proc,ier)
+      use m_stdio,only : stderr
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: proc
+      integer,intent(in) :: ier
+
+! !REVISION HISTORY:
+! 	27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::perr2_'
+  character(len=16) :: cer
+  integer :: ios
+
+  cer='*******'
+  write(cer,'(i16)',iostat=ios) ier
+  write(stderr,'(5a)') where,': ',	&
+	proc,' error, stat =',trim(adjustl(cer))
+
+end subroutine perr2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: perr4_ - send a simple error message to _stderr_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine perr4_(where,mesg1,ival1,mesg2,ival2)
+      use m_stdio,only : stderr
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: mesg1
+      integer,intent(in) :: ival1
+      character(len=*),intent(in) :: mesg2
+      integer,intent(in) :: ival2
+
+! !REVISION HISTORY:
+! 	27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::perr4_'
+  character(len=16) :: cval1,cval2
+  integer :: ios
+
+  cval1='*******'
+  cval2='*******'
+  write(cval1,'(i16)',iostat=ios) ival1
+  write(cval2,'(i16)',iostat=ios) ival2
+
+  write(stderr,'(10a)') where,': error, ',	&
+	mesg1,'=',trim(adjustl(cval1)),', ',	&
+	mesg2,'=',trim(adjustl(cval2)),'.'
+
+end subroutine perr4_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MPdie2_ - invoke MP_perr before die_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine MPdie2_(where,proc,ier)
+      use m_mpif90, only : MP_perr
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: proc
+      integer,intent(in) :: ier
+
+! !REVISION HISTORY:
+! 	27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MPdie2_'
+
+  call MP_perr(where,proc,ier)
+  call die0_(where)
+
+end subroutine MPdie2_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: assert_ - an utility called by ASSERT() macro only
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine assert_(str, file, line)
+      use m_mpout,only : mpout,mpout_flush,mpout_close,mpout_ison
+      use m_flow,only : flow_flush
+      use m_dropdead,only : ddie => die
+      implicit none
+      Character(Len=*), Intent(In) :: str	! a message
+      Character(Len=*), Intent(In) :: file	! a filename
+      Integer, Intent(In) :: line		! a line number
+
+! !REVISION HISTORY:
+! 	25Aug00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- modified
+!		- included into m_die for easier module management
+!	before	- Tom Clune
+!		- Created for MPI PSAS implementation as a separate
+!		  module
+! 	19Jan01	- J. Larson <larson@mcs.anl.gov> - removed nested 
+!                 single/double/single quotes in the second argument
+!                 to the call to perr1_().  This was done for the pgf90
+!                 port.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_='ASSERT_'
+
+  call mpout_flush()
+  if(mpout_ison()) call flow_flush(mpout)
+  call mpout_close()
+
+  call perr1_(myname_,'failed: "//str//")')
+  call ddie(myname_,file,line)
+
+End subroutine assert_
+end module m_die
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_dropdead.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_dropdead.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_dropdead.F90	(revision 4775)
@@ -0,0 +1,182 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_dropdead.F90,v 1.4 2007-01-10 03:04:46 rloy Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_dropdead - An abort() with a style
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_dropdead
+      implicit none
+      private	! except
+
+      public	:: die	! terminate a program with a condition
+
+      interface die; module procedure	&
+	die_,	&
+	diex_
+      end interface
+
+! !REVISION HISTORY:
+! 	20Feb97 - Jing Guo <guo@eramus> - defined template
+!EOP
+!_______________________________________________________________________
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+! !IROUTINE: die_ - Clean up and raise an exception to the OS
+!
+! !DESCRIPTION:
+!
+!   A call to die() exits the program with minimum information for
+!   both the user and the operating system.
+!
+! !INTERFACE:
+
+    subroutine die_(where)
+      use m_stdio, only : stderr
+      use m_mpif90,only : MP_comm_world
+      use m_mpif90,only : MP_comm_rank
+      use m_mpif90,only : MP_abort
+      use m_mpif90,only : MP_initialized
+      implicit none
+      character(len=*),intent(in) :: where	! where it is called
+
+! !REVISION HISTORY:
+! 	20Feb97 - Jing Guo <guo@eramus> - defined template
+!       09Jan07 - R. Loy <rloy@mcs.anl.gov> - check for initialized, add
+!                 options for abort 
+!
+!EOP
+!_______________________________________________________________________
+
+  character(len=*),parameter :: myname_='MCT(MPEU)::die.'
+  integer :: myrank,ier
+  logical :: initialized
+
+  call MP_initialized(initialized,ier)
+
+  if (initialized) then
+
+	!-------------------------------------------------
+	! MPI_ should have been initialized for this call
+	!-------------------------------------------------
+
+    call MP_comm_rank(MP_comm_world,myrank,ier)
+
+	! a message for the users:
+
+    write(stderr,'(z3.3,5a)') myrank,'.',myname_,	&
+      ': from ',trim(where),'()'
+
+	! raise a condition to the OS
+
+#ifdef ENABLE_UNIX_ABORT
+    call abort
+#else
+    call MP_abort(MP_comm_world,2,ier)
+#endif
+
+  else
+
+    write(stderr,'(5a)') 'unknown rank .',myname_,	&
+      ': from ',trim(where),'()'
+
+    call abort
+
+  endif
+
+end subroutine die_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: diex_ - Clean up and raise an exception to the OS
+!
+! !DESCRIPTION:
+!
+!   A call to die() exits the program with minimum information for
+!   both the user and the operating system.  This implementation,
+!   however, may be used in conjunction with with a source preprocessor
+!   to produce more detailed location information.
+!
+! !INTERFACE:
+
+    subroutine diex_(where,fnam,line)
+      use m_stdio, only : stderr
+      use m_mpif90,only : MP_comm_world
+      use m_mpif90,only : MP_comm_rank
+      use m_mpif90,only : MP_abort
+      use m_mpif90,only : MP_initialized
+      implicit none
+      character(len=*),intent(in) :: where	! where it is called
+      character(len=*),intent(in) :: fnam
+      integer,intent(in) :: line
+
+! !REVISION HISTORY:
+! 	20Feb97 - Jing Guo <guo@eramus> - defined template
+!       09Jan07 - R. Loy <rloy@mcs.anl.gov> - check for initialized, add
+!                 options for abort 
+!
+!EOP
+!_______________________________________________________________________
+
+  character(len=*),parameter :: myname_='die.'
+  integer :: myrank,ier
+  character(len=16) :: lineno
+
+  logical :: initialized
+
+  write(lineno,'(i16)') line
+
+  call MP_initialized(initialized,ier)
+
+  if (initialized) then
+
+	!-------------------------------------------------
+	! MPI_ should have been initialized for this call
+	!-------------------------------------------------
+
+    call MP_comm_rank(MP_comm_world,myrank,ier)
+
+	! a message for the users:
+    write(stderr,'(z3.3,9a)') myrank,'.',myname_,	&
+      ': from ',trim(where),'()',	&
+      ', line ',trim(adjustl(lineno)),	&
+      ' of file ',fnam
+
+	! raise a condition to the OS
+
+#ifdef ENABLE_UNIX_ABORT
+    call abort
+#else
+    call MP_abort(MP_comm_world,2,ier)
+#endif
+
+  else
+
+	! a message for the users:
+    write(stderr,'(9a)') 'unknown rank .',myname_,	&
+      ': from ',trim(where),'()',	&
+      ', line ',trim(adjustl(lineno)),	&
+      ' of file ',fnam
+
+    call abort
+  endif
+
+
+end subroutine diex_
+!=======================================================================
+end module m_dropdead
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_flow.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_flow.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_flow.F90	(revision 4775)
@@ -0,0 +1,196 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_flow.F90,v 1.3 2004-04-21 22:54:47 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_flow - tracing the program calling tree
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_flow
+      implicit none
+      private	! except
+
+      public :: flow_ci
+      public :: flow_co
+      public :: flow_flush
+      public :: flow_reset
+
+      interface flow_ci;    module procedure ci_;    end interface
+      interface flow_co;    module procedure co_;    end interface
+      interface flow_flush; module procedure flush_; end interface
+      interface flow_reset; module procedure reset_; end interface
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_flow'
+
+  integer,parameter :: MX_TNAME= 64
+  integer,parameter :: LN_TNAME= 32
+
+  integer,save :: mxdep= 0
+  integer,save :: iname=-1
+  character(len=LN_TNAME),save,dimension(0:MX_TNAME-1) :: tname
+
+  character(len=LN_TNAME),save :: ciname=' '
+  character(len=LN_TNAME),save :: coname=' '
+  logical,save :: balanced=.true.
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: ci_ - checking in a level
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ci_(name)
+      implicit none
+      character(len=*),intent(in) :: name
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::ci_'
+
+	! Push in an entry in to a circulated list storage to save
+	! only the last MX_TNAME entries.
+
+  iname=iname+1
+  tname(modulo(iname,MX_TNAME)) = name
+
+  if(mxdep < iname+1) mxdep=iname+1
+end subroutine ci_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: co_ - checking out a level
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine co_(name)
+      use m_chars, only : uppercase
+      implicit none
+      character(len=*),intent(in) :: name
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::co_'
+  character(len=LN_TNAME) :: uname
+
+  if(balanced) then
+    uname='?'
+    balanced=iname >= 0
+    if(balanced) then
+      uname=tname(modulo(iname,MX_TNAME))
+      balanced = uname == ' ' .or. uppercase(uname) == uppercase(name)
+    endif
+    if(.not.balanced) then
+      ciname=uname
+      coname= name
+    endif
+  endif
+
+	! Pop out an entry
+
+  tname(modulo(iname,MX_TNAME))=' '
+  iname=iname-1
+
+end subroutine co_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: flush_ - print all remaining entries in the list
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine flush_(lu)
+      implicit none
+      integer,intent(in) :: lu
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::flush_'
+  integer :: i
+
+	! Nothing to show
+
+  if(mxdep == 0 .and. iname == -1) return
+
+  WRITE(lu,'(2a,i4)',advance='no') myname,': depth =',mxdep
+
+  if(.not.balanced .or. iname < -1) then
+
+    WRITE(lu,'(4a)',advance='no') 		&
+	', ci/co unbalanced at ',trim(ciname),'/',trim(coname)
+
+    write(lu,'(a,i4)') ', level =',iname+1
+    return
+
+  endif
+
+  if(iname >= 0) then
+    write(lu,'(a)',advance='no') ', '
+    do i=0,iname-1
+      write(lu,'(2a)',advance='no') trim(tname(modulo(i,MX_TNAME))),'>'
+    end do
+    write(lu,'(a)',advance='no') trim(tname(modulo(iname,MX_TNAME)))
+  endif
+  write(lu,*)
+
+end subroutine flush_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: reset_ - set the stack to empty
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine reset_()
+      implicit none
+
+! !REVISION HISTORY:
+! 	26Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::reset_'
+  integer :: i
+
+  mxdep=0
+  iname=-1
+  tname(0:MX_TNAME-1)=' '
+
+  ciname=' '
+  coname=' '
+  balanced=.true.
+
+end subroutine reset_
+end module m_flow
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_inpak90.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_inpak90.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_inpak90.F90	(revision 4775)
@@ -0,0 +1,2049 @@
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+! CVS m_inpak90.F90,v 1.8 2006-12-19 00:22:35 jacob Exp
+! CVS MCT_2_8_0  
+!-------------------------------------------------------------------------
+!BOI
+!
+! !TITLE: Inpak 90 Documentation \\ Version 1.01
+!
+! !AUTHORS: Arlindo da Silva
+!
+! !AFFILIATION: Data Assimilation Office, NASA/GSFC, Greenbelt, MD 20771
+!
+! !DATE: June 20, 1996
+!
+! !INTRODUCTION: Package Overview
+!
+!      Inpak 90 is a Fortran (77/90) collection of 
+!      routines/functions for accessing {\em Resource Files} 
+!      in ASCII format. The package is optimized
+!      for minimizing formatted I/O, performing all of its string
+!      operations in memory using Fortran intrinsic functions.
+!
+! \subsection{Resource Files}
+!
+!      A {\em Resource File} is a text file consisting of variable
+!     length lines (records), each possibly starting with a {\em label}
+!     (or {\em key}), followed by some data. A simple resource file 
+!     looks like this:
+!
+! \begin{verbatim}
+! # Lines starting with # are comments which are
+! # ignored during processing.
+! my_file_names:         jan87.dat jan88.dat jan89.dat
+! radius_of_the_earth:   6.37E6  # these are comments too
+! constants:             3.1415   25
+! my_favourite_colors:   green blue 022 # text & number are OK
+! \end{verbatim}
+!
+!    In this example, {\tt my\_file\_names:} and {\tt constants:}
+!    are labels, while {\tt jan87.dat, jan88.dat} and {\tt jan89.dat} are
+!    data associated with label {\tt my\_file\_names:}.
+!    Resource files can also contain simple tables of the form,
+!
+! \begin{verbatim}
+! my_table_name::
+!  1000     3000     263.0   
+!   925     3000     263.0
+!   850     3000     263.0
+!   700     3000     269.0
+!   500     3000     287.0
+!   400     3000     295.8
+!   300     3000     295.8    
+! ::
+! \end{verbatim}
+!
+! Resource files are random access, the particular order of the
+! records are not important (except between ::s in a table definition).
+!
+!    \subsection{A Quick Stroll}
+!
+!    The first step is to load the ASCII resource (rc) file into
+!    memory\footnote{See next section for a complete description
+!    of parameters for each routine/function}:
+!
+! \begin{verbatim}
+!       call i90_LoadF ( 'my_file.rc', iret )
+! \end{verbatim}
+!
+!    The next step is to select the label (record) of interest, say
+!
+! \begin{verbatim}
+!       call i90_label ( 'constants:', iret )
+! \end{verbatim}
+!
+!  The 2 constants above can be retrieved with the following code
+!  fragment:
+! \begin{verbatim}
+!       real    r
+!       integer i
+!       call i90_label ( 'constants:', iret )
+!       r = i90_gfloat(iret)    ! results in r = 3.1415
+!       i = i90_gint(iret)      ! results in i = 25
+! \end{verbatim}
+!
+!  The file names above can be retrieved with the following
+!  code fragment:
+! \begin{verbatim}
+!       character*20 fn1, fn2, fn3
+!       integer      iret
+!       call i90_label ( 'my_file_names:', iret )
+!       call i90_Gtoken ( fn1, iret )  ! ==> fn1 = 'jan87.dat'
+!       call i90_Gtoken ( fn2, iret )  ! ==> fn1 = 'jan88.dat'
+!       call i90_Gtoken ( fn3, iret )  ! ==> fn1 = 'jan89.dat'
+! \end{verbatim}
+!
+! To access the table above, the user first must use {\tt i90\_label()} to 
+! locate the beginning of the table, e.g.,
+!
+! \begin{verbatim}
+!       call i90_label ( 'my_table_name::', iret )
+! \end{verbatim}
+!
+! Subsequently, {\tt i90\_gline()} can be used to gain access to each
+! row of the table. Here is a code fragment to read the above
+! table (7 rows, 3 columns):
+!
+! \begin{verbatim}
+!       real          table(7,3)
+!       character*20  word
+!       integer       iret
+!       call i90_label ( 'my_table_name::', iret )
+!       do i = 1, 7
+!          call i90_gline ( iret )
+!          do j = 1, 3
+!             table(i,j) = i90_gfloat ( iret )
+!          end do                   
+!       end do
+! \end{verbatim}
+!
+! Get the idea?
+! 
+! \newpage
+! \subsection{Main Routine/Functions}
+!
+! \begin{verbatim}
+!  ------------------------------------------------------------------
+!         Routine/Function                  Description
+!  ------------------------------------------------------------------
+!  I90_LoadF ( filen, iret )     loads resource file into memory
+!  I90_Label ( label, iret )     selects a label (key)
+!  I90_GLine ( iret )            selects next line (for tables)
+!  I90_Gtoken ( word, iret )     get next token 
+!  I90_Gfloat ( iret )           returns next float number (function)
+!  I90_GInt ( iret )             returns next integer number (function)
+!  i90_AtoF ( string, iret )     ASCII to float (function)
+!  i90_AtoI ( string, iret )     ASCII to integer (function)
+!  I90_Len ( string )            string length without trailing blanks
+!  LabLin ( label )              similar to i90_label (no iret)
+!  FltGet ( default )            returns next float number (function)
+!  IntGet ( default )            returns next integer number (function)
+!  ChrGet ( default )            returns next character (function)
+!  TokGet ( string, default )    get next token
+!  ------------------------------------------------------------------
+! \end{verbatim}
+!
+! {\em Common Arguments:}
+!
+! \begin{verbatim}
+! character*(*)      filen       file name
+! integer            iret        error return code (0 is OK)
+! character*(*)      label       label (key) to locate record
+! character*(*)      word        blank delimited string
+! character*(*)      string      a sequence of characters
+! \end{verbatim}
+!
+! See the Prologues in the next section for additional details.
+!
+!
+!    \subsection{Package History} 
+!       Back in the 70s Eli Isaacson wrote IOPACK in Fortran
+!       66.  In June of 1987 I wrote Inpak77 using
+!       Fortran 77 string functions; Inpak 77 is a vastly
+!       simplified IOPACK, but has its own goodies not found in
+!       IOPACK.  Inpak 90 removes some obsolete functionality in
+!       Inpak77, and parses the whole resource file in memory for
+!       performance.  Despite its name, Inpak 90 compiles fine
+!       under any modern Fortran 77 compiler.
+!
+!   \subsection{Bugs} 
+!       Inpak 90 is not very gracious with error messages.  
+!       The interactive functionality of Inpak77 has not been implemented.
+!       The comment character \# cannot be escaped.
+!
+!  \subsection{Availability}
+!
+!   This software is available at 
+! \begin{verbatim}
+!         ftp://niteroi.gsfc.nasa.gov/pub/packages/i90/ 
+! \end{verbatim}
+!   There you will find the following files:
+! \begin{verbatim}
+! i90.f      Fortran 77/90 source code
+! i90.h      Include file needed by i90.f
+! ti90.f     Test code
+! i90.ps     Postscript documentation
+! \end{verbatim}
+! An on-line version of this document is available at
+! \begin{verbatim}
+!        ftp://niteroi.gsfc.nasa.gov/www/packages/i90/i90.html
+! \end{verbatim}
+!
+!EOI
+!-------------------------------------------------------------------------
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!
+! !REVISION HISTORY:
+! 	03Jul96 - J. Guo	- evolved to Fortran 90 module.  The
+!		modifications include 1) additional subroutines to
+!		dynamically manage the memory, 2) privatized most
+!		entries, 3) included "i90.h" into the module source
+!		with better initializations, 4) removed blockdata, 5)
+!		used a portable opntext() call to avoid I/O portability
+!		problems.
+!
+!		See I90_page() I90_Release(), and I90_LoadF() for
+!		details.
+!
+!	05Aug98	- Jing Guo	-
+!		  Removed i90_page() and its references.
+!		  Added internal subroutines push_() and pop_().
+!		  Modified i90_release().
+!		  Added i90_fullrelease().
+!		  Removed %loaded.  Check i90_depth instead.
+!       06Aug98 - Todling       - made I90_gstr public
+!	20Dec98 - Jing Guo	- replaced the description of I90_Gstr
+!	28Sep99 - Jing Guo	- Merged with the MPI version with
+!				  some addtional changes based on
+!				  merging decisions.
+!	12Oct99 - Larson/Guo	- Overloaded fltget() to new routines 
+!                 getfltsp() and fltgetdp(), providing better support 
+!                 for 32 and 64 bit platforms, respectively.
+!_______________________________________________________________________
+
+     module m_inpak90
+     use m_stdio, only : stderr,stdout
+     use m_realkinds, only: FP, SP, DP,kind_r8
+     implicit none
+     private
+     public :: I90_LoadF   ! loads a resource file into memory
+     public :: I90_allLoadF! loads/populates a resource file to all PEs
+     public :: I90_Release ! Releases one cached resource file
+     public :: I90_fullRelease ! Releases the whole stack
+     public :: I90_Label   ! selects a label (key)
+     public :: I90_GLine   ! selects the next line (for tables)
+     public :: I90_Gtoken  ! gets the next token 
+     public :: I90_Gstr    ! get a string upto to a "$" or EOL
+
+     public :: I90_AtoF	! ASCII to float (function)
+     public :: I90_AtoI	! ASCII to integer (function)
+
+     public :: I90_Gfloat  ! returns next float number (function)
+     public :: I90_GInt	! returns next integer number (function)
+
+     public :: lablin,rdnext,fltget,intget,getwrd,str2rn,chrget,getstr
+     public :: strget
+
+     interface fltget; module procedure &
+	  fltgetsp, &
+	  fltgetdp
+     end interface
+
+
+!-----------------------------------------------------------------------
+!
+!	This part was originally in "i90.h", but included for module.
+!
+
+		! revised parameter table to fit Fortran 90 standard
+
+  integer,   parameter :: LSZ      = 256
+
+!ams
+! On Linux with the Fujitsu compiler, I needed to reduce NBUF_MAX
+!ams 
+! integer,   parameter :: NBUF_MAX = 400*(LSZ) ! max size of buffer
+! integer,   parameter :: NBUF_MAX = 200*(LSZ) ! max size of buffer
+! Further reduction of NBUF_MAX was necessary for the Fujitsu VPP:
+  integer,   parameter :: NBUF_MAX = 128*(LSZ)-1 ! Maximum buffer size
+                                                 ! that works with the
+                                                 ! Fujitsu-VPP platform.
+
+
+  character, parameter :: BLK = achar(32)   ! blank (space)
+  character, parameter :: TAB = achar(09)   ! TAB
+  character, parameter :: EOL = achar(10)   ! end of line mark (newline)
+  character, parameter :: EOB = achar(00)   ! end of buffer mark (null)
+  character, parameter :: NULL= achar(00)   ! what it says
+
+  type inpak90
+		! May be easily paged for extentable file size (J.G.)
+
+    integer :: nbuf                           ! actual size of buffer
+    character(len=NBUF_MAX),pointer :: buffer ! hold the whole file?
+    character(len=LSZ),     pointer :: this_line ! the current line
+
+    integer :: next_line  ! index for next line on buffer
+
+    type(inpak90),pointer :: last
+  end type inpak90
+
+  integer,parameter :: MALLSIZE_=10	! just an estimation
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_inpak90'
+!-----------------------------------------------------------------------
+
+    integer,parameter :: i90_MXDEP = 4
+    integer,save      :: i90_depth = 0
+    type(inpak90),save,pointer :: i90_now
+
+!-----------------------------------------------------------------------
+      contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: I90_allLoadF - populate a rooted database to all PEs
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine I90_allLoadF(fname,root,comm,istat)
+      use m_mpif90, only : MP_perr
+      use m_mpif90, only : MP_comm_rank
+      use m_mpif90, only : MP_CHARACTER
+      use m_mpif90, only : MP_INTEGER
+      use m_die, only : perr
+      implicit none
+      character(len=*),intent(in) :: fname
+      integer,intent(in) :: root
+      integer,intent(in) :: comm
+      integer,intent(out) :: istat
+
+! !REVISION HISTORY:
+! 	28Jul98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::I90_allLoadF'
+  integer :: myID,ier
+
+  istat=0
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier/=0) then
+    call MP_perr(myname_,'MP_comm_rank()',ier)
+    istat=ier
+    return
+  endif
+
+  if(myID == root) then
+    call i90_LoadF(fname,ier)
+    if(ier /= 0) then
+      call perr(myname_,'i90_LoadF("//trim(fname)//")',ier)
+      istat=ier
+      return
+    endif
+  else
+    call push_(ier)
+    if(ier /= 0) then
+      call perr(myname_,'push_()',ier)
+      istat=ier
+      return
+    endif
+  endif
+
+	! Initialize the buffer on all PEs
+
+  call MPI_Bcast(i90_now%buffer,NBUF_MAX,MP_CHARACTER,root,comm,ier)
+  if(ier /= 0) then
+    call MP_perr(myname_,'MPI_Bcast(%buffer)',ier)
+    istat=ier
+    return
+  endif
+
+  call MPI_Bcast(i90_now%nbuf,1,MP_INTEGER,root,comm,ier)
+  if(ier /= 0) then
+    call MP_perr(myname_,'MPI_Bcast(%nbuf)',ier)
+    istat=ier
+    return
+  endif
+
+  i90_now%this_line=' '
+  i90_now%next_line=0
+
+end subroutine I90_allLoadF
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: push_ - push on a new layer of the internal file _i90_now_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine push_(ier)
+      use m_die, only : perr
+      use m_mall,only : mall_mci,mall_ci,mall_ison
+      implicit none
+      integer,intent(out) :: ier
+
+! !REVISION HISTORY:
+! 	05Aug98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::push_'
+  type(inpak90),pointer :: new
+
+  if(i90_depth <= 0) nullify(i90_now)	! just an initialization
+
+	! Too many levels
+
+  if(i90_depth >= i90_MXDEP) then
+	call perr(myname_,'(overflow)',i90_depth)
+	ier=1
+	return
+  endif
+
+  allocate(new,stat=ier)
+	if(ier /= 0) then
+	  call perr(myname_,'allocate(new)',ier)
+	  return
+	endif
+
+	if(mall_ison()) call mall_ci(MALLSIZE_,myname)
+
+  allocate(new%buffer,new%this_line,stat=ier)
+	if(ier /= 0) then
+	  call perr(myname_,'allocate(new%..)',ier)
+	  return
+	endif
+
+	if(mall_ison()) then
+	  call mall_mci(new%buffer,myname)
+	  call mall_mci(new%this_line,myname)
+	endif
+
+  new%last => i90_now
+  i90_now  => new
+  nullify(new)
+
+  i90_depth = i90_depth+1
+end subroutine push_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: pop_ - pop off a layer of the internal file _i90_now_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine pop_(ier)
+      use m_die, only : perr
+      use m_mall,only : mall_mco,mall_co,mall_ison
+      implicit none
+      integer,intent(out) :: ier
+
+! !REVISION HISTORY:
+! 	05Aug98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::pop_'
+  type(inpak90),pointer :: old
+
+  if(i90_depth <= 0) then
+	call perr(myname_,'(underflow)',i90_depth)
+	ier=1
+	return
+  endif
+
+  old => i90_now%last
+
+	if(mall_ison()) then
+	  call mall_mco(i90_now%this_line,myname)
+	  call mall_mco(i90_now%buffer,myname)
+	endif
+
+  deallocate(i90_now%buffer,i90_now%this_line,stat=ier)
+	if(ier /= 0) then
+	  call perr(myname_,'deallocate(new%..)',ier)
+	  return
+	endif
+
+	if(mall_ison())  call mall_co(MALLSIZE_,myname)
+
+  deallocate(i90_now,stat=ier)
+	if(ier /= 0) then
+	  call perr(myname_,'deallocate(new)',ier)
+	  return
+	endif
+
+  i90_now => old
+  nullify(old)
+
+  i90_depth = i90_depth - 1
+end subroutine pop_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!
+! !ROUTINE: I90_Release - deallocate memory used to load a resource file
+!
+! !INTERFACE:
+!
+      subroutine I90_Release(stat)
+	use m_die,only : perr,die
+	implicit none
+	integer,optional, intent(out) :: stat 
+!
+! !DESCRIPTION:
+!
+!	I90_Release() is used to pair I90_LoadF() to release the memory
+!	used by I90_LoadF() for resourse data input.
+!
+! !SEE ALSO:
+!
+! !REVISION HISTORY:
+! 	03Jul96 - J. Guo	- added to Arlindos inpak90 for its
+!				  Fortran 90 revision.
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::i90_Release'
+  integer :: ier
+
+  if(present(stat)) stat=0
+
+  call pop_(ier)
+  if(ier/=0) then
+    call perr(myname_,'pop_()',ier)
+    if(.not.present(stat)) call die(myname_)
+    stat=ier
+    return
+  endif
+
+ end subroutine I90_Release
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: i90_fullRelease - releases the whole stack led by _i90_now_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine i90_fullRelease(ier)
+      use m_die,only : perr
+      implicit none
+      integer,intent(out) :: ier
+
+! !REVISION HISTORY:
+! 	05Aug98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::i90_fullRelease'
+
+  do while(i90_depth > 0)
+    call pop_(ier)
+    if(ier /= 0) then
+      call perr(myname_,'pop_()',ier)
+      return
+    endif
+  end do
+  ier=0
+
+end subroutine i90_fullRelease
+!=======================================================================
+      subroutine I90_LoadF ( filen, iret )
+	use m_ioutil, only : luavail,opntext,clstext
+	use m_die, only : perr
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_LoadF() --- Loads resource file into memory.
+! 
+! !DESCRIPTION: 
+!
+!  Reads resource file, strips out comments, translate TABs into
+!  blanks, and loads the modified file contents into memory.
+!  Must be called only once for each resource file.
+!
+! !CALLING SEQUENCE: 
+!
+!     call i90_LoadF ( filen, iret )
+!
+! !INPUT PARAMETERS: 
+!
+      character*(*) filen            ! file name
+
+! !OUTPUT PARAMETERS:
+
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     ! -98    coult not get unit number
+                                     !        (strange!)
+                                     ! -98    talk to a wizzard
+                                     ! -99    out of memory: increase
+                                     !        NBUF_MAX in 'i90.h'
+                                     ! other  iostat from open statement.
+!
+! !BUGS:  
+!
+!  It does not perform dynamic allocation, mostly to keep vanilla f77
+!  compatibility. Overall amount of static memory is small (~100K
+!  for default NBUF_MAX = 400*256).
+!
+! !SEE ALSO: 
+!
+!  i90_label()   selects a label (key)
+!
+! !FILES USED:  
+!
+!  File name supplied on input. The file is opened, read and then closed.
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+      integer         lu, ios, loop, ls, ptr
+      character*256   line
+      character(len=*), parameter :: myname_ = myname//'::i90_loadf'
+
+		! Check to make sure there is not too many levels
+		! of the stacked resource files
+
+  if(i90_depth >= i90_MXDEP) then
+	call perr(myname_,'(overflow)',i90_depth)
+	iret=1
+	return
+  endif
+
+!     Open file
+!     ---------     
+!      lu = i90_lua()
+
+      lu = luavail()	! a more portable version
+      if ( lu .lt. 0 ) then
+         iret = -97
+         return
+      end if
+
+	! A open through an interface to avoid portability problems.
+	! (J.G.)
+
+      call opntext(lu,filen,'old',ios)
+      if ( ios .ne. 0 ) then
+	 write(stderr,'(2a,i5)') myname_,': opntext() error, ios =',ios
+         iret = ios
+         return
+      end if
+
+	! Create a dynamic page to store the file.  It might be expanded
+	! to allocate memory on requests (a link list) (J.G.)
+
+	! Changed from page_() to push_(), to allow multiple (stacked)
+	! inpak90 buffers.  J.G.
+
+      call push_(ios)	! to create buffer space
+      if ( ios .ne. 0 ) then
+	 write(stderr,'(2a,i5)') myname_,': push_() error, ios =',ios
+         iret = ios
+         return
+      end if
+
+!     Read to end of file
+!     -------------------
+      i90_now%buffer(1:1) = EOL
+      ptr = 2                         ! next buffer position
+      do loop = 1, NBUF_MAX
+
+!        Read next line
+!        --------------
+         read(lu,'(a)', end=11) line  ! read next line
+         call i90_trim ( line )      ! remove trailing blanks
+         call i90_pad ( line )        ! Pad with # from end of line
+
+!        A non-empty line
+!        ----------------
+         ls = index(line,'#' ) - 1    ! line length
+         if ( ls .gt. 0 ) then
+              if ( (ptr+ls) .gt. NBUF_MAX ) then
+                 iret = -99
+                 return
+              end if
+              i90_now%buffer(ptr:ptr+ls) = line(1:ls) // EOL
+              ptr = ptr + ls + 1
+         end if
+
+      end do
+
+      iret = -98 ! good chance i90_now%buffer is not big enough 
+      return
+
+ 11   continue
+
+!     All done
+!     --------
+!      close(lu)
+	call clstext(lu,ios)
+	if(ios /= 0) then
+	  iret=-99
+	  return
+	endif
+      i90_now%buffer(ptr:ptr) = EOB
+      i90_now%nbuf = ptr
+      i90_now%this_line=' '
+      i90_now%next_line=0
+      iret = 0
+
+      return
+      end subroutine I90_LoadF
+
+            
+!...................................................................
+
+      subroutine i90_label ( label, iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_Label() --- Selects a label (record).
+! 
+! !DESCRIPTION: 
+!
+!  Once the buffer has been loaded with {\tt i90\_loadf()}, this routine
+!  selects a given ``line'' (record/table) associated with ``label''. 
+!  Think of ``label'' as a resource name or data base ``key''.
+!
+! !CALLING SEQUENCE: 
+!           
+!     call i90_Label ( label, iret )
+!
+! !INPUT PARAMETERS: 
+!
+      character(len=*),intent(in) :: label            ! input label
+
+! !OUTPUT PARAMETERS:
+
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    buffer not loaded
+                                     !  -2    could not find label   
+!
+! !SEE ALSO: 
+!
+!  i90_loadf()    load file into buffer
+!  i90_gtoken()   get next token
+!  i90_gline()    get next line (for tables)
+!  atof()         convert word (string) to float
+!  atoi()         convert word (string) to integer
+!  
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  19Jan01   Jay Larson <larson@mcs.anl.gov> - introduced CHARACTER 
+!            variable EOL_label, which is used to circumvent pgf90
+!            problems with passing concatenated characters as an argument
+!            to a function.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer i, j
+
+      character(len=(len(label)+len(EOL))) :: EOL_label
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+!     Determine whether label exists
+!     ------------------------------     
+      EOL_label = EOL // label
+      i = index ( i90_now%buffer(1:i90_now%nbuf), EOL_label ) + 1
+      if ( i .le. 1 ) then
+           i90_now%this_line = BLK // EOL
+           iret = -2
+           return
+      end if
+
+!     Extract the line associated with this label
+!     -------------------------------------------
+      i = i + len ( label )
+      j = i + index(i90_now%buffer(i:i90_now%nbuf),EOL) - 2
+      i90_now%this_line = i90_now%buffer(i:j) // BLK // EOL
+
+      i90_now%next_line = j + 2
+
+      iret = 0
+
+      return
+      end subroutine i90_label
+
+!...................................................................
+
+      subroutine i90_gline ( iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_GLine() --- Selects next line.
+! 
+! !DESCRIPTION: 
+!
+!     Selects next line, irrespective of of label. If the next line starts
+! with :: (end of table mark), then it lets the user know. This sequential
+! access of the buffer is useful to assess tables, a concept introduced
+! in Inpak 77 by Jing Guo. A table is a construct like this:
+!
+! \begin{verbatim}
+! my_table_name::
+!  1000     3000     263.0   
+!   925     3000     263.0
+!   850     3000     263.0
+!   700     3000     269.0
+!   500     3000     287.0
+!   400     3000     295.8
+!   300     3000     295.8    
+! ::
+! \end{verbatim}
+!
+! To access this table, the user first must use {\tt i90\_label()} to 
+! locate the beginning of the table, e.g.,
+!
+! \begin{verbatim}
+!       call i90_label ( 'my_table_name::', iret )
+! \end{verbatim}
+!
+! Subsequently, {\tt i90\_gline()} can be used to gain acess to each
+! row of the table. Here is a code fragment to read the above
+! table (7 rows, 3 columns):
+!
+! \begin{verbatim}
+!       real          table(7,3)
+!       character*20  word
+!       integer       iret
+!       call i90_label ( 'my_table_name::', iret )
+!       do i = 1, 7
+!          call i90_gline ( iret )
+!          do j = 1, 3
+!             table(i,j) = fltget ( 0. )
+!          end do                   
+!       end do
+! \end{verbatim}
+!
+!  For simplicity we have assumed that the dimensions of table were
+!  known. It is relatively simple to infer the table dimensions
+!  by manipulating ``iret''.
+!
+! !CALLING SEQUENCE: 
+!
+!     call i90_gline ( iret )
+!
+! !INPUT PARAMETERS: 
+!
+!     None.
+!
+! !OUTPUT PARAMETERS:
+!
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    end of buffer reached
+                                     !  +1    end of table  reached
+
+! !SEE ALSO: 
+!
+!  i90_label()    selects a line (record/table)
+!
+! !REVISION HISTORY: 
+!
+!  10feb95   Guo        Wrote rdnext(), Inpak 77 extension.
+!  19Jun96   da Silva   Original code with functionality of rdnext()
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer i, j
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+      if ( i90_now%next_line .ge. i90_now%nbuf ) then
+         iret = -1
+         return
+      end if
+
+      i = i90_now%next_line
+      j = i + index(i90_now%buffer(i:i90_now%nbuf),EOL) - 2
+      i90_now%this_line = i90_now%buffer(i:j) // BLK // EOL
+      
+      if ( i90_now%this_line(1:2) .eq. '::' ) then
+           iret = 1                        ! end of table
+           i90_now%next_line = i90_now%nbuf + 1
+           return
+      end if
+
+      i90_now%next_line = j + 2
+      iret = 0
+
+      return
+      end subroutine i90_gline
+
+!...................................................................
+            
+      subroutine i90_GToken ( token, iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_GToken()  --- Gets next token.
+! 
+! !DESCRIPTION: 
+!
+!  Get next token from current line. The current line is defined by a
+!  call to {\tt i90\_label()}. Tokens are sequences of characters (including
+!  blanks) which may be enclosed by single or double quotes. 
+!  If no quotes are present, the token from the current position to the next
+!  blank of TAB is returned.
+!  
+!  {\em Examples of valid token:}
+!
+!  \begin{verbatim}
+!               single_token "second token on line"
+!               "this is a token"
+!               'Another example of a token'
+!               'this is how you get a " inside a token'
+!               "this is how you get a ' inside a token"
+!               This is valid too   # the line ends before the #
+!  \end{verbatim}
+!  The last line has 4 valid tokens: {\tt This, is, valid} and {\tt too}.
+!  
+!  {\em Invalid string constructs:}
+!
+!  \begin{verbatim}
+!               cannot handle mixed quotes (i.e. single/double)
+!               'escaping like this \' is not implemented'
+!               'this # will not work because of the #'
+!  \end{verbatim}
+!  The \# character is reserved for comments and cannot be included
+!  inside quotation marks.
+!
+! !CALLING SEQUENCE: 
+!
+!     call i90_GToken ( token, iret )
+!
+! !INPUT PARAMETERS: 
+!
+!     None.
+!
+! !OUTPUT PARAMETERS:
+!
+      character*(*) token            ! Next token from current line
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    either nothing left
+                                     !        on line or mismatched
+                                     !        quotation marks.
+
+! !BUGS:  
+!
+!     Standard Unix escaping is not implemented at the moment.
+!     
+!
+! !SEE ALSO: 
+!
+!  i90_label()    selects a line (record/table)
+!  i90_gline()    get next line (for tables)
+!  atof()         convert word (string) to float
+!  atoi()         convert word (string) to integer
+!  
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*1   ch
+      integer       ib, ie
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+      call i90_trim ( i90_now%this_line )
+     
+      ch = i90_now%this_line(1:1)
+      if ( ch .eq. '"' .or. ch .eq. "'" ) then
+           ib = 2
+           ie = index ( i90_now%this_line(ib:), ch ) 
+      else
+           ib = 1
+           ie = min(index(i90_now%this_line,BLK),	&
+		    index(i90_now%this_line,EOL)) - 1
+
+      end if
+
+      if ( ie .lt. ib ) then
+           token = BLK
+           iret = -1
+           return
+      else
+		! Get the token, and shift the rest of %this_line to
+		! the left
+
+           token = i90_now%this_line(ib:ie) 
+           i90_now%this_line = i90_now%this_line(ie+2:)
+           iret = 0
+      end if
+
+      return
+      end subroutine i90_gtoken
+!...................................................................
+      subroutine i90_gstr ( string, iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!
+! !ROUTINE:  I90\_GStr()
+! 
+! !DESCRIPTION: 
+!
+!  Get next string from current line. The current line is defined by a
+!  call to {\tt i90\_label()}. Strings are sequence of characters (including
+!  blanks) enclosed by single or double quotes. If no quotes
+!  are present, the string from the current position to the end of 
+!  the line is returned.
+!
+!  NOTE: This routine is defined differently from \verb"i90_GTolen()",
+!	 where a {\sl token} is white-space delimited, but this routine
+!	 will try to fetch a string either terminated by a "$" or by the
+!	 end of the line.
+!
+!  {\em Examples of valid strings:}
+!
+!  \begin{verbatim}
+!               "this is a string"
+!               'Another example of string'
+!               'this is how you get a " inside a string'
+!               "this is how you get a ' inside a string"
+!               This is valid too   # the line ends before the #
+!
+!  \end{verbatim}
+!  
+!  {\em Invalid string constructs:}
+!
+!  \begin{verbatim}
+!               cannot handle mixed quotes
+!               'escaping like this \' is not implemented'
+!  \end{verbatim}
+!
+!  {\em Obsolete feature (for Inpak 77 compatibility):}
+!
+!  \begin{verbatim}
+!               the string ends after a $ this is another string
+!  \end{verbatim}
+!
+! !CALLING SEQUENCE: 
+!
+!  \begin{verbatim}
+!     call i90_Gstr ( string, iret )
+!  \end{verbatim}
+!
+! !INPUT PARAMETERS: 
+!
+      character*(*) string           ! A NULL (char(0)) delimited string.
+
+! !OUTPUT PARAMETERS:
+!
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    either nothing left
+                                     !        on line or mismatched
+                                     !        quotation marks.
+
+! !BUGS:  
+!
+!     Standard Unix escaping is not implemented at the moment.
+!     No way to tell sintax error from end of line (same iret).
+!     
+!
+! !SEE ALSO: 
+!
+!  i90_label()    selects a line (record/table)
+!  i90_gtoken()   get next token
+!  i90_gline()    get next line (for tables)
+!  atof()         convert word (string) to float
+!  atoi()         convert word (string) to integer
+!  
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  01Oct96   Jing Guo	Removed the null terminitor
+!
+!-------------------------------------------------------------------------
+
+      character*1   ch
+      integer       ib, ie
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+      call i90_trim ( i90_now%this_line )
+     
+      ch = i90_now%this_line(1:1)
+      if ( ch .eq. '"' .or. ch .eq. "'" ) then
+           ib = 2
+           ie = index ( i90_now%this_line(ib:), ch ) 
+      else
+           ib = 1
+           ie = index(i90_now%this_line,'$')-1  ! undocumented feature!
+           if ( ie .lt. 1 ) ie = index(i90_now%this_line,EOL)-2
+      end if
+
+      if ( ie .lt. ib ) then
+!         string = NULL
+           iret = -1
+           return
+      else
+           string = i90_now%this_line(ib:ie) ! // NULL
+           i90_now%this_line = i90_now%this_line(ie+2:)
+           iret = 0
+      end if
+
+      return
+      end subroutine i90_gstr
+
+!...................................................................
+
+      real(FP) function i90_GFloat( iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: i90_GFloat() --- Returns next float number.
+! 
+! !DESCRIPTION: 
+!
+!  Returns next float (real number) from the current line.
+!  If an error occurs a zero value is returned.
+!
+! !CALLING SEQUENCE: 
+!
+!      real  rnumber
+!      rnumber = i90_gfloat ( default )
+!
+! !OUTPUT PARAMETERS: 
+!
+      integer,intent(out) :: iret    ! Return code:
+                                     !   0    no error
+                                     !  -1    either nothing left
+                                     !        on line or mismatched
+                                     !        quotation marks.
+                                     !  -2    parsing error
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      integer       ios
+      real(FP)      x
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+      call i90_gtoken ( token, iret )
+      if ( iret .eq. 0 ) then
+           read(token,*,iostat=ios) x	! Does it require an extension?
+           if ( ios .ne. 0 ) iret = -2
+      end if
+      if ( iret .ne. 0 ) x = 0.
+      i90_GFloat = x
+
+      return
+      end function i90_GFloat
+
+!...................................................................
+
+      integer function I90_GInt ( iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: I90_GInt() --- Returns next integer number.
+! 
+! !DESCRIPTION: 
+!
+!  Returns next integer number from the current line.
+!  If an error occurs a zero value is returned.
+!
+! !CALLING SEQUENCE: 
+!
+!      integer number
+!      number = i90_gint ( default )
+!
+! !OUTPUT PARAMETERS: 
+!
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    either nothing left
+                                     !        on line or mismatched
+                                     !        quotation marks.
+                                     !  -2    parsing error
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  24may00   da Silva   delcared x as real*8 in case this module is compiled
+!                       with real*4
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      real(kind_r8) x
+      integer       ios
+
+!	Make sure that a buffer is defined (JG)
+!	----------------------------------
+	if(i90_depth <= 0) then
+	  iret = -1
+	  return
+	endif
+
+      call i90_gtoken ( token, iret )
+      if ( iret .eq. 0 ) then
+           read(token,*,iostat=ios) x
+           if ( ios .ne. 0 ) iret = -2
+      end if
+      if ( iret .ne. 0 ) x = 0
+      i90_gint = nint(x)
+
+      return
+      end function i90_gint
+      
+!...................................................................
+
+      real(FP) function i90_AtoF( string, iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  i90_AtoF() --- Translates ASCII (string) to float.
+! 
+! !DESCRIPTION: 
+!
+!     Converts string to real number. Same as obsolete {\tt str2rn()}.
+!
+! !CALLING SEQUENCE: 
+!
+!     real  rnumber
+!     rnumber = i90_atof ( string, iret )
+!
+! !INPUT PARAMETERS: 
+!
+      character(len=*),intent(in) :: string           ! a string
+
+! !OUTPUT PARAMETERS:
+!
+      integer,intent(out) :: iret    ! Return code:
+                                     !   0    no error
+                                     !  -1    could not convert, probably
+                                     !        string is not a number
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      read(string,*,end=11,err=11) i90_AtoF
+      iret = 0
+      return
+ 11   iret = -1
+      return
+      end function i90_AtoF
+
+!...................................................................
+
+      integer function i90_atoi ( string, iret )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_AtoI() --- Translates ASCII (strings) to integer.
+! 
+! !DESCRIPTION: 
+!
+!     Converts string to integer number.
+!
+! !CALLING SEQUENCE: 
+!
+!     integer number
+!     number = i90_atoi ( string, iret )
+!
+! !INPUT PARAMETERS: 
+!
+      character*(*) string           ! a string
+
+! !OUTPUT PARAMETERS:
+!
+      integer       iret             ! Return code:
+                                     !   0    no error
+                                     !  -1    could not convert, probably
+                                     !        string is not a number
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      read(string,*,end=11,err=11) i90_atoi
+      iret = 0
+      return
+ 11   iret = -1
+      return
+      end function i90_atoi
+
+!...................................................................
+
+      integer function i90_Len ( string )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_Len() --- Returns length of string.
+! 
+! !DESCRIPTION: 
+!
+!  Returns the length of a string excluding trailing blanks.
+!  It follows that 
+!  \begin{verbatim}
+!              i90_len(string) .le. len(string),
+!  \end{verbatim}
+!  where {\tt len} is the intrinsic string length function.  
+!  Example:
+!  \begin{verbatim}
+!         ls = len('abc  ')       ! results in ls = 5
+!         ls = i90_len ('abc  ')  ! results in ls = 3
+!  \end{verbatim}
+!
+! !CALLING SEQUENCE: 
+!
+!       integer ls
+!       ls = i90_len ( string )
+!
+! !INPUT PARAMETERS: 
+!
+         character*(*)   string     ! a string
+!
+! !OUTPUT PARAMETERS:
+!
+!        The length of the string, excluding trailing blanks.
+!
+! !REVISION HISTORY: 
+!
+!  01Apr94   Guo        Original code (a.k.a. luavail())
+!  19Jun96   da Silva   Minor modification + prologue.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer ls, i, l
+      ls = len(string)
+      do i = ls, 1, -1
+         l = i
+         if ( string(i:i) .ne. BLK ) go to 11
+      end do
+      l = l - 1
+ 11   continue
+      i90_len = l
+      return
+      end function i90_len
+      
+!...................................................................
+
+      integer function I90_Lua()
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_Lua() --- Returns available logical unit number.
+! 
+! !DESCRIPTION: 
+!
+!  Look for an available (not opened) Fortran logical unit for i/o.
+!
+! !CALLING SEQUENCE: 
+!
+!       integer lu
+!       lu = i90_lua()
+!
+! !INPUT PARAMETERS: 
+!
+!       None.
+!
+! !OUTPUT PARAMETERS:
+!
+!       The desired unit number if positive, -1 if unsucessful.
+!
+! !REVISION HISTORY: 
+!
+!  01Apr94   Guo        Original code (a.k.a. luavail())
+!  19Jun96   da Silva   Minor modification + prologue.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+
+      integer lu,ios
+      logical opnd
+      lu=7
+      inquire(unit=lu,opened=opnd,iostat=ios)
+      do while(ios.eq.0.and.opnd)
+         lu=lu+1
+         inquire(unit=lu,opened=opnd,iostat=ios)
+      end do
+      if(ios.ne.0) lu=-1
+      i90_lua=lu
+      return
+      end function i90_lua
+      
+!...................................................................
+
+      subroutine i90_pad ( string )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_Pad() --- Pad strings.
+! 
+! !DESCRIPTION: 
+!
+!     Pads from the right with the comment character (\#). It also
+!  replaces TABs with blanks for convenience. This is a low level
+!  i90 routine.
+!
+! !CALLING SEQUENCE: 
+!
+!      call i90_pad ( string )
+!
+! !INPUT PARAMETERS: 
+!
+       character*256 string       ! input string
+
+! !OUTPUT PARAMETERS:            ! modified string
+!
+!      character*256 string
+!
+! !BUGS:  
+!
+!      It alters TABs even inside strings.
+!
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer i
+
+!     Pad end of string with #
+!     ------------------------
+      do i = 256, 1, -1 
+         if ( string(i:i) .ne. ' ' .and.	&
+	        string(i:i) .ne. '$' ) go to 11
+         string(i:i) = '#'
+      end do
+ 11   continue
+
+!     Replace TABs with blanks
+!     -------------------------
+      do i = 1, 256
+         if ( string(i:i) .eq. TAB ) string(i:i) = BLK
+         if ( string(i:i) .eq. '#' ) go to 21
+      end do
+ 21   continue
+
+      return
+      end subroutine i90_pad
+         
+!...................................................................
+
+      subroutine I90_Trim ( string )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  I90_Trim() - Removes leading blanks from strings.
+!
+! !DESCRIPTION: 
+!
+!    Removes blanks and TABS from begenning of string. 
+!    This is a low level i90 routine.
+! 
+! !CALLING SEQUENCE: 
+!
+!     call i90_Trim ( string )
+!
+! !INPUT PARAMETERS: 
+!
+      character*256 string    ! the input string
+!
+! !OUTPUT PARAMETERS:
+!
+!     character*256 string    ! the modified string
+!
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer     ib, i
+
+!     Get rid of leading blanks
+!     -------------------------
+      ib = 1
+      do i = 1, 255
+         if ( string(i:i) .ne. ' ' .and.	&
+	        string(i:i) .ne. TAB ) go to 21
+         ib = ib + 1
+      end do
+ 21   continue
+
+!     String without trailling blanks
+!     -------------------------------
+      string = string(ib:)
+
+      return
+      end subroutine i90_trim
+
+
+!==========================================================================
+
+
+!                        -----------------------------
+!                        Inpak 77 Upward Compatibility
+!                        -----------------------------
+
+
+      subroutine lablin ( label )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE:  Lablin() --- Selects a Label (Inpak 77)
+! 
+! !DESCRIPTION: 
+!
+!    Selects a given ``line'' (record/table) associated with ``label''. 
+!    Similar to {\tt i90\_label()}, but prints a message to {\tt stdout}
+!    if it cannot locate the label. Kept for Inpak 77 upward compatibility.
+!
+! !CALLING SEQUENCE: 
+!
+!     call lablin ( label )
+!
+! !INPUT PARAMETERS: 
+
+      character(len=*),intent(in) :: label   ! string with label name
+!
+! !OUTPUT PARAMETERS:
+!
+!    None.
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer       iret
+
+      call i90_label ( label, iret )
+      if ( iret .ne. 0 ) then
+	write(stderr,'(2a)') 'i90/lablin: cannot find label ', label
+      endif
+
+      end subroutine lablin
+      
+!...................................................................
+
+      real(SP) function fltgetsp ( default )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: FltGetsp() --- Returns next float (Inpak 77, single precision)
+! 
+! !DESCRIPTION: 
+!
+!  Returns next float (real number, single precision) from the current 
+!  line, or a default value if it fails to obtain the desired number.
+!  Kept for Inpak 77 upward compatibility.
+!
+! !CALLING SEQUENCE: 
+!
+!      real  rnumber, default
+!      rnumber = fltgetsp ( default )
+!
+! !INPUT PARAMETERS: 
+!
+      real(SP), intent(IN) ::    default       ! default value.
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  12Oct99   Guo/Larson - Built from original FltGet() function.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      real(FP)      x
+      integer       iret
+
+      call i90_gtoken ( token, iret )
+      if ( iret .eq. 0 ) then
+           read(token,*,iostat=iret) x
+      end if
+      if ( iret .ne. 0 ) x = default
+      !print *, x
+      fltgetsp = x
+
+      return
+      end function fltgetsp
+      
+!...................................................................
+
+      real(DP) function fltgetdp ( default )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: FltGetdp() --- Returns next float (Inpak 77)
+! 
+! !DESCRIPTION: 
+!
+!  Returns next float (real number) from the current line, or a 
+!  default value (double precision) if it fails to obtain the desired 
+!  number.  Kept for Inpak 77 upward compatibility.
+!
+! !CALLING SEQUENCE: 
+!
+!      real(DP) :: default
+!      real :: rnumber 
+!      rnumber = FltGetdp(default)
+!
+! !INPUT PARAMETERS: 
+!
+      real(DP), intent(IN) ::    default       ! default value.
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  12Oct99   Guo/Larson - Built from original FltGet() function.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      real(FP)          x
+      integer       iret
+
+      call i90_gtoken ( token, iret )
+      if ( iret .eq. 0 ) then
+           read(token,*,iostat=iret) x
+      end if
+      if ( iret .ne. 0 ) x = default
+      !print *, x
+      fltgetdp = x
+
+      return
+      end function fltgetdp
+      
+!...................................................................
+
+      integer function intget ( default )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: IntGet() --- Returns next integer (Inpak 77). 
+! 
+! !DESCRIPTION: 
+!
+!  Returns next integer number from the current line, or a default 
+!  value if it fails to obtain the desired number.
+!  Kept for Inpak 77 upward compatibility.
+!
+! !CALLING SEQUENCE: 
+!
+!      integer number, default
+!      number = intget ( default )
+!
+! !INPUT PARAMETERS: 
+!
+       integer     default       ! default value.
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      real(FP)      x
+      integer       iret
+
+      call i90_gtoken ( token, iret )
+      if ( iret .eq. 0 ) then
+           read(token,*,iostat=iret) x
+      end if
+      if ( iret .ne. 0 ) x = default
+      intget = nint(x)
+      !print *, intget
+
+      return
+      end function intget
+      
+!...................................................................
+
+      character(len=1) function chrget ( default )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: ChrGet() --- Returns next character (Inpak 77).
+! 
+! !DESCRIPTION: 
+!
+!  Returns next non-blank character from the current line, or a default 
+!  character if it fails for whatever reason.
+!  Kept for Inpak 77 upward compatibility.
+!
+! !CALLING SEQUENCE: 
+!
+!     character*1 ch, default
+!     ch = chrget ( default )
+!
+! !INPUT PARAMETERS: 
+!
+      character*1    default       ! default value.
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      character*256 token
+      integer       iret
+
+      call i90_gtoken ( token, iret )
+      if ( iret .ne. 0 ) then
+           chrget = default
+      else
+           chrget = token(1:1)
+      end if
+      !print *, chrget
+
+      return
+      end function chrget
+
+!...................................................................
+
+      subroutine TokGet ( token, default )
+
+      implicit NONE
+
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !ROUTINE: TokGet() --- Gets next token (Inpakk 77 like).
+! 
+! !DESCRIPTION: 
+!
+!  Returns next token from the current line, or a default 
+!  word if it fails for whatever reason.
+!
+! !CALLING SEQUENCE: 
+!
+!      call TokGet ( token, default )
+!
+! !INPUT PARAMETERS: 
+!
+       character*(*) default     ! default token
+
+! !OUTPUT PARAMETERS:
+!
+       character*(*) token       ! desired token
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!
+!EOP
+!-------------------------------------------------------------------------
+
+      integer       iret
+
+      call i90_GToken ( token, iret )
+      if ( iret .ne. 0 ) then
+           token = default
+      end if
+      !print *, token
+
+      return
+      end subroutine tokget
+      
+!====================================================================
+
+!                          --------------------------
+!                          Obsolete Inpak 77 Routines
+!                              (Not Documented)
+!                          --------------------------
+
+!...................................................................
+
+      subroutine iniin()
+      print *, 		&
+           'i90: iniin() is obsolete, use i90_loadf() instead!'
+      return
+      end subroutine iniin
+   
+
+!...................................................................
+
+      subroutine iunits ( mifans, moftrm, moferr, miftrm )
+      integer mifans, moftrm, moferr, miftrm 
+      print *, 		&
+           'i90: iunits() is obsolete, use i90_loadf() instead!'
+      return
+      end subroutine iunits
+   
+!...................................................................
+
+      subroutine getstr ( iret, string )
+      implicit NONE
+      character*(*) string 
+      integer       iret  !, ls
+      call i90_gstr ( string, iret )
+      return
+      end subroutine getstr
+
+!...................................................................
+
+      subroutine getwrd ( iret, word )
+      implicit NONE
+      character*(*) word
+      integer       iret
+      call i90_gtoken ( word, iret )
+      return
+      end subroutine getwrd
+
+!...................................................................
+
+      subroutine rdnext ( iret )
+      implicit NONE
+      integer iret
+      call i90_gline ( iret )
+      return
+      end subroutine rdnext
+
+!...................................................................
+            
+      real(FP) function str2rn ( string, iret )
+      implicit NONE
+      character*(*) string
+      integer iret
+      read(string,*,end=11,err=11) str2rn
+      iret = 0
+      return
+ 11   iret = 1
+      return
+      end function str2rn
+
+!...................................................................
+
+      subroutine strget ( string, default )
+
+      implicit NONE
+
+!-------------------------------------------------------------------------
+!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-------------------------------------------------------------------------
+!
+! !ROUTINE: StrGet()
+! 
+! !DESCRIPTION: 
+!
+!  Returns next string on the current line, or a default 
+!  string if it fails for whatever reason. Similar to {\tt i90\_gstr()}.
+!  Kept for Inpak 77 upward compatibility.
+!
+!  NOTE: This is an obsolete routine. The notion of "string" used
+!        here is not conventional. Please use routine {\tt TokGet()}
+!        instead.
+!
+! !CALLING SEQUENCE: 
+!
+!      call strget ( string, default )
+!
+! !INPUT PARAMETERS: 
+!
+       character*(*) default      ! default string
+
+! !OUTPUT PARAMETERS:
+
+       character*(*) string       ! desired string
+
+!
+! !REVISION HISTORY: 
+!
+!  19Jun96   da Silva   Original code.
+!  01Oct96   Jing Guo   Removed the null terminitor
+!
+!-------------------------------------------------------------------------
+
+      integer iret
+
+      call i90_gstr ( string, iret )
+      if ( iret .ne. 0 ) then
+           string = default
+      end if
+
+      return
+      end subroutine strget
+      
+
+end module m_inpak90
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_ioutil.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_ioutil.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_ioutil.F90	(revision 4775)
@@ -0,0 +1,439 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_ioutil.F90,v 1.16 2006-07-06 22:06:25 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_ioutil - a F90 module for several convenient I/O functions
+!
+! !DESCRIPTION:
+!
+!	m\_ioutil is a module containing several portable interfaces for
+!	some highly system dependent, but frequently used I/O functions.
+!
+! !INTERFACE:
+
+	module m_ioutil
+	implicit none
+	private	! except
+
+	public	:: opntext,clstext ! open/close a text file
+	public	:: opnieee,clsieee ! open/close a binary sequential file
+	public	:: luavail	   ! return a free logical unit
+	public	:: luflush	   ! flush the buffer of a given unit
+	!public	:: MX_LU
+
+! !REVISION HISTORY:
+! 	16Jul96 - J. Guo	- (to do)
+! 	02Apr97 - Jing Guo <guo@eramus> - finished the coding
+!	11Feb97 - Jing Guo <guo@thunder> - added luflush()
+!       08Nov01  - Jace A Mogill <mogill@cray.com>  FORTRAN only defines 
+!                 99 units, three units below unit 10 are often used for
+!                 stdin, stdout, and stderr.  Be far more conservative
+!                 and stay within FORTRAN standard.
+!
+!EOP
+!_______________________________________________________________________
+
+	character(len=*),parameter :: myname="MCT(MPEU)::m_ioutil"
+	integer,parameter :: MX_LU=99
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: opnieee - portablly open an IEEE format file
+!
+! !DESCRIPTION:
+!
+!	Open a file in IEEE format.
+!
+!	IEEE format is refered as a FORTRAN "unformatted" file with
+!	"sequantial" access and variable record lengths.  Under common
+!	Unix, it is only a file with records packed with a leading 4-
+!	byte word and a trailing 4-byte word indicating the size of
+!	the record in bytes.  However, under UNICOS, it is also assumed
+!	to have numerical data representations represented according to
+!	the IEEE standard corresponding KIND conversions.  Under a DEC
+!	machine, it means that compilations of the source code should
+!	have the "-bigendian" option specified.
+!
+! !INTERFACE:
+
+    subroutine opnieee(lu,fname,status,ier,recl)
+      use m_stdio,only : stderr
+      implicit none
+
+      integer,         intent(in) :: lu     ! logical unit number
+      character(len=*),intent(in) :: fname  ! filename to be opended
+      character(len=*),intent(in) :: status ! the value for STATUS=
+      integer,         intent(out):: ier    ! the status
+      integer,optional,intent(in) :: recl   ! record length
+
+! !REVISION HISTORY:
+!	02Feb95 - Jing G. - First version included in PSAS.  It is not
+!		used in the libpsas.a calls, since no binary data input/
+!		output is to be handled.
+!
+! 	09Oct96 - J. Guo  - Check for any previous assign() call under
+!		UNICOS.
+!EOP
+!_______________________________________________________________________
+
+#ifdef _UNICOS
+	character(len=128) :: attr
+#endif
+
+		! local parameter
+	character(len=*),parameter :: myname_=myname//'::opnieee'
+
+	integer,parameter :: iA=ichar('a')
+	integer,parameter :: mA=ichar('A')
+	integer,parameter :: iZ=ichar('z')
+
+	logical :: direct
+	character(len=16) :: clen
+	character(len=len(status)) :: Ustat
+	integer :: i,ic
+
+! Work-around for absoft 9.0 f90, which has trouble understanding that
+! ier is an output argument from the write() call below.
+
+	ier = 0
+
+	direct=.false.
+	if(present(recl)) then
+	  if(recl<0) then
+	    clen='****************'
+	    write(clen,'(i16)',iostat=ier) recl
+	    write(stderr,'(3a)') myname_,	&
+		': invalid recl, ',trim(adjustl(clen))
+	    ier=-1
+	    return
+	  endif
+	  direct = recl>0
+	endif
+
+#ifdef _UNICOS
+	call asnqunit(lu,attr,ier)	! test the unit
+
+	if(ier.eq.-1) then		! the unit is not used
+	  if(direct) then
+	    call asnunit(lu,'-N ieee -F null',ier)
+	  else
+	    call asnunit(lu,'-N ieee -F f77',ier)
+	  endif
+	  ier=0
+
+	elseif(ier.ge.0) then		! the unit is already assigned
+	  ier=-1
+	endif
+	if(ier.ne.0) return
+#endif
+
+	do i=1,len(status)
+	  ic=ichar(status(i:i))
+	  if(ic >= iA .and. ic <= iZ) ic=ic+(mA-iA)
+	  Ustat(i:i)=char(ic)
+	end do
+
+	select case(Ustat)
+
+	case ('APPEND')
+
+	  if(direct) then
+	    write(stderr,'(2a)') myname_,		&
+		': invalid arguments, (status=="APPEND",recl>0)'
+	    ier=1
+	    return
+	  endif
+
+	  open(				&
+	    unit	=lu,		&
+	    file	=fname,		&
+	    form	='unformatted',	&
+	    access	='sequential',	&
+	    status	='unknown',	&
+	    position	='append',	&
+	    iostat	=ier		)
+
+	case default
+
+	  if(direct) then
+	    open(			&
+	      unit	=lu,		&
+	      file	=fname,		&
+	      form	='unformatted',	&
+	      access	='direct',	&
+	      status	=status,	&
+	      recl	=recl,		&
+	      iostat	=ier		)
+
+	  else
+	    open(			&
+	      unit	=lu,		&
+	      file	=fname,		&
+	      form	='unformatted',	&
+	      access	='sequential',	&
+	      status	=status,	&
+	      position	='asis',	&
+	      iostat	=ier		)
+	  endif
+
+	end select
+
+	end subroutine opnieee
+!-----------------------------------------------------------------------
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: clsieee - Close a logical unit opened by opnieee()
+!
+! !DESCRIPTION:
+!
+!	The reason for a paired clsieee() for opnieee() instead of a
+!	simple close(), is for the portability reason.  For example,
+!	under UNICOS, special system calls may be need to set up the
+!	unit right, and the status of the unit should be restored upon
+!	close.
+!
+! !INTERFACE:
+
+	subroutine clsieee(lu,ier)
+	  implicit none
+	  integer, intent(in)  :: lu	! the unit used by opnieee()
+	  integer, intent(out) :: ier	! the status
+
+! !REVISION HISTORY:
+! 	10Oct96 - J. Guo	- (to do)
+!EOP
+!_______________________________________________________________________
+	  close(lu,iostat=ier)
+#ifdef _UNICOS
+	  if(ier==0) call asnunit(lu,'-R',ier) ! remove attributes
+#endif
+
+	end subroutine clsieee
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: opntext - portablly open a text file
+!
+! !DESCRIPTION:
+!
+!	Open a text (ASCII) file.  Under FORTRAN, it is defined as
+!	"formatted" with "sequential" access.
+!
+! !INTERFACE:
+
+    subroutine opntext(lu,fname,status,ier)
+      implicit none
+
+      integer,         intent(in) :: lu     ! logical unit number
+      character(len=*),intent(in) :: fname  ! filename to be opended
+      character(len=*),intent(in) :: status ! the value for STATUS=<>
+      integer,         intent(out):: ier    ! the status
+
+
+! !REVISION HISTORY:
+!
+!	02Feb95 - Jing G. - First version included in PSAS and libpsas.a
+! 	09Oct96 - J. Guo  - modified to allow assign() call under UNICOS
+!			  = and now, it is a module in Fortran 90.
+!EOP
+!_______________________________________________________________________
+
+		! local parameter
+	character(len=*),parameter :: myname_=myname//'::opntext'
+
+	integer,parameter :: iA=ichar('a')
+	integer,parameter :: mA=ichar('A')
+	integer,parameter :: iZ=ichar('z')
+
+	character(len=len(status)) :: Ustat
+	integer :: i,ic
+
+#ifdef _UNICOS
+	call asnunit(lu,'-R',ier)	! remove any set attributes
+	if(ier.ne.0) return		! let the parent handle it
+#endif
+
+	do i=1,len(status)
+	  ic=ichar(status(i:i))
+	  if(ic >= iA .and. ic <= iZ) ic=ic+(mA-iA)
+	  Ustat(i:i)=char(ic)
+	end do
+
+	select case(Ustat)
+
+	case ('APPEND')
+
+	  open(				&
+	    unit	=lu,		&
+	    file	=fname,		&
+	    form	='formatted',	&
+	    access	='sequential',	&
+	    status	='unknown',	&
+	    position	='append',	&
+	    iostat	=ier		)
+
+	case default
+
+	  open(				&
+	    unit	=lu,		&
+	    file	=fname,		&
+	    form	='formatted',	&
+	    access	='sequential',	&
+	    status	=status,	&
+	    position	='asis',	&
+	    iostat	=ier		)
+
+	end select
+
+	end subroutine opntext
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: clstext - close a text file opend with an opntext() call
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine clstext(lu,ier)
+      implicit none
+
+      integer, intent(in)  :: lu  ! a logical unit to close
+      integer, intent(out) :: ier ! the status
+
+! !REVISION HISTORY:
+! 	09Oct96 - J. Guo	- (to do)
+!EOP
+!_______________________________________________________________________
+
+	close(lu,iostat=ier)
+#ifdef _UNICOS
+	if(ier == 0) call asnunit(lu,'-R',ier)	! remove any attributes
+#endif
+
+	end subroutine clstext
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: luavail - locate the next available unit
+!
+! !DESCRIPTION:
+!
+!    luavail() Look for an available (not opened and not statically
+!    assigned to any I/O attributes to) logical unit.
+!
+! !INTERFACE:
+
+	function luavail()
+	  use m_stdio
+	  implicit none
+	  integer :: luavail	! result
+
+! !REVISION HISTORY:
+! 	23Apr98 - Jing Guo <guo@thunder> - new prototype/prolog/code
+!			- with additional unit constraints for SunOS.
+!
+! 	: Jing Guo, [09-Oct-96]
+! 		+ Checking also Cray assign() attributes, with some
+! 		  changes to the code.  See also other routines.
+!
+! 	: Jing Guo, [01-Apr-94]
+! 		+ Initial code.
+!   2001-11-08  - Jace A Mogill <mogill@cray.com>  clean up
+!		  logic for finding lu.
+!
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::luavail'
+
+	integer lu,ios
+	logical inuse
+
+	lu=10
+	ios=0
+	inuse=.true.
+
+	do while(ios.eq.0 .and. inuse .and. lu.le.MX_LU)
+	  lu=lu+1
+	  inquire(unit=lu,opened=inuse,iostat=ios)
+	end do
+
+	if(ios.ne.0) lu=-1
+	luavail=lu
+end function luavail
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: luflush - a uniform interface of system flush()
+!
+! !DESCRIPTION:
+!
+!	Flush() calls available on many systems are often implementation
+!	dependent.  This subroutine provides a uniform interface.  It
+!	also ignores invalid logical unit value.
+!
+! !INTERFACE:
+
+    subroutine luflush(unit)
+      use m_stdio, only : stdout
+#ifdef CPRNAG
+      use F90_UNIX_IO,only : flush
+#endif
+      implicit none
+      integer,optional,intent(in) :: unit
+
+! !REVISION HISTORY:
+! 	13Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!       08Jul02 - E. Ong <eong@mcs.anl.gov> - added flush support for nag95
+!  2001-11-08  Jace A Mogill <mogill@cray.com>  - Flush is not part of
+!              the F90 standard.  Default is NO unit flush.
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::luflush'
+
+  integer :: ier
+  integer :: lu
+
+	! Which logical unit number?
+
+  lu=stdout
+  if(present(unit)) lu=unit
+  if(lu < 0) return
+
+	! The following call may be system dependent.
+
+#if SYSIRIX64 || CPRNAG || SYSUNICOS
+  call flush(lu,ier)
+#elif  SYSAIX || CPRXLF
+  call flush_(lu)      ! Function defined in xlf reference document.
+#elif SYSLINUX || SYSOSF1 || SYSSUNOS || SYST3E || SYSUNIXSYSTEMV || SYSSUPERUX
+  call flush(lu)
+#endif
+
+end subroutine luflush
+!-----------------------------------------------------------------------
+end module m_ioutil
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mall.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mall.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mall.F90	(revision 4775)
@@ -0,0 +1,1669 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_mall.F90,v 1.5 2004-04-21 22:54:47 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_mall - A bookkeeper of user allocated memories
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_mall
+      implicit none
+      private	! except
+
+      public :: mall_ci
+      public :: mall_co
+      public :: mall_mci
+      public :: mall_mco
+      public :: mall_flush
+      public :: mall_reset
+
+		! mall_ activity controls
+
+      public :: mall_ison
+      public :: mall_set
+
+      interface mall_ci;    module procedure ci_; end interface
+      interface mall_co;    module procedure co_; end interface
+
+      interface mall_mci;    module procedure	&
+	ciI0_,	&
+	ciI1_,	&
+	ciI2_,	&
+	ciI3_,	&
+	ciR0_,	&
+	ciR1_,	&
+	ciR2_,	&
+	ciR3_,	&
+	ciD0_,	&
+	ciD1_,	&
+	ciD2_,	&
+	ciD3_,	&
+	ciL0_,	&
+	ciL1_,	&
+	ciL2_,	&
+	ciL3_,	&
+	ciC0_,	&
+	ciC1_,	&
+	ciC2_,	&
+	ciC3_
+      end interface
+
+      interface mall_mco;    module procedure	&
+	coI0_,	&
+	coI1_,	&
+	coI2_,	&
+	coI3_,	&
+	coR0_,	&
+	coR1_,	&
+	coR2_,	&
+	coR3_,	&
+	coD0_,	&
+	coD1_,	&
+	coD2_,	&
+	coD3_,	&
+	coL0_,	&
+	coL1_,	&
+	coL2_,	&
+	coL3_,	&
+	coC0_,	&
+	coC1_,	&
+	coC2_,	&
+	coC3_
+      end interface
+
+      interface mall_flush; module procedure flush_; end interface
+      interface mall_reset; module procedure reset_; end interface
+
+      interface mall_ison; module procedure ison_; end interface
+      interface mall_set;  module procedure set_;  end interface
+
+! !REVISION HISTORY:
+! 	13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_mall'
+
+#if SYSUNICOS || SYSIRIX64 || _R8_
+  integer,parameter :: NBYTE_PER_WORD = 8
+#else
+  integer,parameter :: NBYTE_PER_WORD = 4
+#endif
+
+  integer,parameter :: NSZ= 32
+  integer,parameter :: MXL=250
+
+  integer, save :: nreset = 0		! number of reset_() calls
+  logical, save :: started = .false.	! the module is in use
+
+  integer, save :: n_ =0		! number of accouting bins.
+  character(len=NSZ),dimension(MXL),save :: name_
+
+  ! integer, dimension(1) :: mall
+					! names of the accouting bins
+
+  logical,save :: mall_on=.false.	! mall activity switch
+
+  integer,save :: mci
+  integer,dimension(MXL),save :: mci_	! maximum ci_() calls
+  integer,save :: nci
+  integer,dimension(MXL),save :: nci_	! net ci_() calls
+  integer,save :: hwm
+  integer,dimension(MXL),save :: hwm_	! high-water-mark of allocate()
+  integer,save :: nwm
+  integer,dimension(MXL),save :: nwm_	! net-water-mark of allocate()
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ison_ -
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function ison_()
+      implicit none
+      logical :: ison_
+
+! !REVISION HISTORY:
+! 	25Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ison_'
+
+  ison_=mall_on
+
+end function ison_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: set_ - set the switch on
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine set_(on)
+      implicit none
+      logical,optional,intent(in) :: on
+
+! !REVISION HISTORY:
+! 	25Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::set_'
+
+  mall_on=.true.
+  if(present(on)) mall_on=on
+
+end subroutine set_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciI0_ - check in as an integer scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciI0_(marg,thread)
+      implicit none
+      integer,intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciI0_'
+
+  if(mall_on) call ci_(1,thread)
+
+end subroutine ciI0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciI1_ - check in as an integer rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciI1_(marg,thread)
+      implicit none
+      integer,dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciI1_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciI1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciI2_ - check in as an integer rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciI2_(marg,thread)
+      implicit none
+      integer,dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciI2_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciI2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciI3_ - check in as an integer rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciI3_(marg,thread)
+      implicit none
+      integer,dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciI3_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciI3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciR0_ - check in as a real(SP) scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciR0_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciR0_'
+
+  if(mall_on) call ci_(1,thread)
+
+end subroutine ciR0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciR1_ - check in as a real(SP) rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciR1_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciR1_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciR1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciR2_ - check in as a real(SP) rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciR2_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciR2_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciR2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciR3_ - check in as a real(SP) rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciR3_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciR3_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciR3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciD0_ - check in as a real(DP) scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciD0_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciD0_'
+
+  if(mall_on) call ci_(2,thread)
+
+end subroutine ciD0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciD1_ - check in as a real(DP) rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciD1_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciD1_'
+
+  if(mall_on) call ci_(2*size(marg),thread)
+
+end subroutine ciD1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciD2_ - check in as a real(DP) rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciD2_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciD2_'
+
+  if(mall_on) call ci_(2*size(marg),thread)
+
+end subroutine ciD2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciD3_ - check in as a real(DP) rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciD3_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciD3_'
+
+  if(mall_on) call ci_(2*size(marg),thread)
+
+end subroutine ciD3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciL0_ - check in as a logical scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciL0_(marg,thread)
+      implicit none
+      logical,intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciL0_'
+
+  if(mall_on) call ci_(1,thread)
+
+end subroutine ciL0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciL1_ - check in as a logical rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciL1_(marg,thread)
+      implicit none
+      logical,dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciL1_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciL1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciL2_ - check in as a logical rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciL2_(marg,thread)
+      implicit none
+      logical,dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciL2_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciL2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciL3_ - check in as a logical rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciL3_(marg,thread)
+      implicit none
+      logical,dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciL3_'
+
+  if(mall_on) call ci_(size(marg),thread)
+
+end subroutine ciL3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciC0_ - check in as a character scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciC0_(marg,thread)
+      implicit none
+      character(len=*),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciC0_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg)+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call ci_(nw,thread)
+
+end subroutine ciC0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciC1_ - check in as a character rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciC1_(marg,thread)
+      implicit none
+      character(len=*),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciC1_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call ci_(size(marg)*nw,thread)
+
+end subroutine ciC1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciC2_ - check in as a character rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciC2_(marg,thread)
+      implicit none
+      character(len=*),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciC2_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call ci_(size(marg)*nw,thread)
+
+end subroutine ciC2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ciC3_ - check in as a character rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ciC3_(marg,thread)
+      implicit none
+      character(len=*),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ciC3_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1,1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call ci_(size(marg)*nw,thread)
+
+end subroutine ciC3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: ci_ - check-in allocate activity
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ci_(nword,thread)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      implicit none
+      integer,intent(in) :: nword
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::ci_'
+  integer :: ith
+
+  if(.not.mall_on) return
+
+  if(nword < 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': invalide argument, nword = ',nword
+    call die(myname_)
+  endif
+
+  ith=lookup_(thread)
+
+	! update the account
+
+  nci_(ith)=nci_(ith)+1
+  mci_(ith)=mci_(ith)+1
+  nwm_(ith)=nwm_(ith)+nword
+  if(hwm_(ith).lt.nwm_(ith)) hwm_(ith)=nwm_(ith)
+
+	! update the total budget
+
+  nci=nci+1
+  mci=mci+1
+  nwm=nwm+nword
+  if(hwm.lt.nwm) hwm=nwm
+
+end subroutine ci_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coI0_ - check in as an integer scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coI0_(marg,thread)
+      implicit none
+      integer,intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coI0_'
+
+  if(mall_on) call co_(1,thread)
+
+end subroutine coI0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coI1_ - check in as an integer rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coI1_(marg,thread)
+      implicit none
+      integer,dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coI1_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coI1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coI2_ - check in as an integer rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coI2_(marg,thread)
+      implicit none
+      integer,dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coI2_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coI2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coI3_ - check in as an integer rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coI3_(marg,thread)
+      implicit none
+      integer,dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coI3_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coI3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coR0_ - check in as a real(SP) scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coR0_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coR0_'
+
+  if(mall_on) call co_(1,thread)
+
+end subroutine coR0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coR1_ - check in as a real(SP) rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coR1_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coR1_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coR1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coR2_ - check in as a real(SP) rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coR2_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coR2_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coR2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coR3_ - check in as a real(SP) rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coR3_(marg,thread)
+      use m_realkinds, only : SP
+      implicit none
+      real(SP),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coR3_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coR3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coD0_ - check in as a real(DP) scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coD0_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coD0_'
+
+  if(mall_on) call co_(2,thread)
+
+end subroutine coD0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coD1_ - check in as a real(DP) rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coD1_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coD1_'
+
+  if(mall_on) call co_(2*size(marg),thread)
+
+end subroutine coD1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coD2_ - check in as a real(DP) rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coD2_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coD2_'
+
+  if(mall_on) call co_(2*size(marg),thread)
+
+end subroutine coD2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coD3_ - check in as a real(DP) rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coD3_(marg,thread)
+      use m_realkinds, only : DP
+      implicit none
+      real(DP),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coD3_'
+
+  if(mall_on) call co_(2*size(marg),thread)
+
+end subroutine coD3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coL0_ - check in as a logical scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coL0_(marg,thread)
+      implicit none
+      logical,intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coL0_'
+
+  if(mall_on) call co_(1,thread)
+
+end subroutine coL0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coL1_ - check in as a logical rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coL1_(marg,thread)
+      implicit none
+      logical,dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coL1_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coL1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coL2_ - check in as a logical rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coL2_(marg,thread)
+      implicit none
+      logical,dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coL2_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coL2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coL3_ - check in as a logical rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coL3_(marg,thread)
+      implicit none
+      logical,dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coL3_'
+
+  if(mall_on) call co_(size(marg),thread)
+
+end subroutine coL3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coC0_ - check in as a character scalar
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coC0_(marg,thread)
+      implicit none
+      character(len=*),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coC0_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg)+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call co_(nw,thread)
+
+end subroutine coC0_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coC1_ - check in as a character rank 1 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coC1_(marg,thread)
+      implicit none
+      character(len=*),dimension(:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coC1_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call co_(size(marg)*nw,thread)
+
+end subroutine coC1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coC2_ - check in as a character rank 2 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coC2_(marg,thread)
+      implicit none
+      character(len=*),dimension(:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coC2_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call co_(size(marg)*nw,thread)
+
+end subroutine coC2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: coC3_ - check in as a character rank 3 array
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine coC3_(marg,thread)
+      implicit none
+      character(len=*),dimension(:,:,:),intent(in) :: marg
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	21Oct99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::coC3_'
+  integer :: nw
+
+  if(.not.mall_on) return
+  nw=(len(marg(1,1,1))+NBYTE_PER_WORD-1)/NBYTE_PER_WORD
+  call co_(size(marg)*nw,thread)
+
+end subroutine coC3_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: co_ - check-out allocate activity
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine co_(nword,thread)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      implicit none
+      integer,intent(in) :: nword
+      character(len=*),intent(in) :: thread
+
+! !REVISION HISTORY:
+! 	13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::co_'
+  integer :: ith
+
+  if(.not.mall_on) return
+
+  if(nword < 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': invalide argument, nword = ',nword
+    call die(myname_)
+  endif
+
+	! if the thread is "unknown", it would be treated as a
+	! new thread with net negative memory activity.
+
+  ith=lookup_(thread)
+
+	! update the account
+
+  nci_(ith)=nci_(ith)-1
+  nwm_(ith)=nwm_(ith)-nword
+
+	! update the total budget
+
+  nci=nci-1
+  nwm=nwm-nword
+
+end subroutine co_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: cix_ - handling macro ALLOC_() error
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine cix_(thread,stat,fnam,line)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      implicit none
+      character(len=*),intent(in) :: thread
+      integer,intent(in) :: stat
+      character(len=*),intent(in) :: fnam
+      integer,intent(in) :: line
+
+
+! !REVISION HISTORY:
+! 	13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::cix_'
+
+  write(stderr,'(2a,i4)') trim(thread),	&
+	': ALLOC_() error, stat =',stat
+  call die('ALLOC_',fnam,line)
+
+end subroutine cix_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: cox_ - handling macro DEALLOC_() error
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine cox_(thread,stat,fnam,line)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      implicit none
+      character(len=*),intent(in) :: thread
+      integer,intent(in) :: stat
+      character(len=*),intent(in) :: fnam
+      integer,intent(in) :: line
+
+! !REVISION HISTORY:
+! 	13Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::cox_'
+
+  write(stderr,'(2a,i4)') trim(thread),	&
+	': DEALLOC_() error, stat =',stat
+  call die('DEALLOC_',fnam,line)
+
+end subroutine cox_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: flush_ - balancing the up-to-date ci/co calls
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine flush_(lu)
+      use m_stdio, only : stderr
+      use m_ioutil, only : luflush
+      use m_die, only : die
+      implicit none
+      integer,intent(in) :: lu
+
+! !REVISION HISTORY:
+! 	17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::flush_'
+
+  integer,parameter :: lnmax=38
+  character(len=max(lnmax,NSZ)) :: name
+
+  character(len=6) :: hwm_wd,nwm_wd
+  character(len=1) :: flag_ci,flag_wm
+  integer :: i,ier,ln
+
+  if(.not.mall_on) return
+
+  if(.not.started) call reset_()
+
+  write(lu,'(72a/)',iostat=ier) ('_',i=1,72)
+  if(ier /= 0) then
+    write(stderr,'(2a,i3)') myname_,': can not write(), unit =',lu
+    call die(myname_)
+  endif
+
+  write(lu,'(a,t39,4(2x,a))',iostat=ier) '[MALL]',	&
+  		'max-ci','net-ci ','max-wm','net-wm'
+  if(ier /= 0) then
+    write(stderr,'(2a,i4)') myname_,': can not write(), unit =',lu
+    call die(myname_)
+  endif
+
+  call luflush(lu)
+
+!23.|....1....|....2....|....3....|....4....|....5....|....6....|....7..
+!_______________________________________________________________________
+!
+![MALL]                                 max_ci  net-ci   max-wm  net-wm
+!-----------------------------------------------------------------------
+!total.                                 ...333  ...333*  ..333M  ..333i*
+!_______________________________________________________________________
+
+  write(lu,'(72a)') ('-',i=1,72)
+
+  do i=1,min(n_,MXL)
+    call wcount_(hwm_(i),hwm_wd)
+    call wcount_(nwm_(i),nwm_wd)
+      
+    flag_ci=' '
+    if(nci_(i) /= 0) flag_ci='*'
+
+    flag_wm=' '
+    if(nwm_(i) /= 0) flag_wm='*'
+
+    name=name_(i)
+    ln=max(len_trim(name),lnmax)
+    write(lu,'(a,2(2x,i6),a,2(2x,a6),a)') name(1:ln),	&
+	mci_(i),nci_(i),flag_ci,hwm_wd,nwm_wd,flag_wm
+  end do
+
+  call wcount_(hwm,hwm_wd)
+  call wcount_(nwm,nwm_wd)
+      
+  flag_ci=' '
+  if(nci /= 0) flag_ci='*'
+  flag_wm=' '
+  if(nwm /= 0) flag_wm='*'
+
+  name='.total.'
+  ln=max(len_trim(name),lnmax)
+  write(lu,'(a,2(2x,i6),a,2(2x,a6),a)') name(1:ln),	&
+	mci,nci,flag_ci,hwm_wd,nwm_wd,flag_wm
+
+  write(lu,'(72a/)') ('_',i=1,72)
+
+  if(nreset /= 1) write(lu,'(2a,i3,a)') myname_,	&
+	': reset_ ',nreset,' times'
+
+  call luflush(lu)
+end subroutine flush_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: wcount_ - generate word count output with unit
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine wcount_(wknt,cknt)
+      implicit none
+
+      integer,         intent(in)  :: wknt ! given an integer value
+      character(len=6),intent(out) :: cknt ! return a string value
+
+! !REVISION HISTORY:
+! 	17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::wcount_'
+
+character(len=1) :: cwd
+integer,parameter :: KWD=1024
+integer,parameter :: MWD=1024*1024
+integer,parameter :: GWD=1024*1024*1024
+
+integer :: iwd
+
+if(wknt < 0) then
+  cknt='------'
+else
+  cwd='i'
+  iwd=wknt
+  if(iwd > 9999) then
+    cwd='K'
+    iwd=(wknt+KWD-1)/KWD
+  endif
+  if(iwd > 9999) then
+    cwd='M'
+    iwd=(wknt+MWD-1)/MWD
+  endif
+  if(iwd > 9999) then
+    cwd='G'
+    iwd=(wknt+GWD-1)/GWD
+  endif
+  write(cknt,'(i5,a)') iwd,cwd
+endif
+end subroutine wcount_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: lookup_ - search/insert a name in a list
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function lookup_(thread)
+      use m_chars, only : uppercase
+      implicit none
+      character(len=*),intent(in) :: thread
+      integer :: lookup_
+
+! !REVISION HISTORY:
+! 	17Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::lookup_'
+
+  logical :: found
+  integer :: ith
+
+  if(.not.started) call reset_()
+
+!----------------------------------------
+ith=0
+found=.false.
+do while(.not.found .and. ith < min(n_,MXL))
+  ith=ith+1
+  found= uppercase(thread) == uppercase(name_(ith))
+end do
+
+if(.not.found) then
+  if(n_==0) then
+    nci=0
+    mci=0
+    nwm=0
+    hwm=0
+  endif
+
+  n_=n_+1
+  if(n_ == MXL) then
+    ith=MXL
+    name_(ith)='.overflow.'
+  else
+    ith=n_
+    name_(ith)=thread
+  endif
+
+  nci_(ith)=0
+  mci_(ith)=0
+  nwm_(ith)=0
+  hwm_(ith)=0
+endif
+
+lookup_=ith
+
+end function lookup_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: reset_ - initialize the module data structure
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine reset_()
+      implicit none
+
+! !REVISION HISTORY:
+! 	16Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::reset_'
+
+  if(.not.mall_on) return
+
+  nreset=nreset+1
+  started=.true.
+
+  name_(1:n_)=' '
+
+  mci_(1:n_)=0
+  nci_(1:n_)=0
+  hwm_(1:n_)=0
+  nwm_(1:n_)=0
+
+  n_ =0
+
+  mci=0
+  nci=0
+  hwm=0
+  nwm=0
+
+end subroutine reset_
+!=======================================================================
+end module m_mall
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif.F90	(revision 4775)
@@ -0,0 +1,69 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_mpif.F90,v 1.2 2004-04-21 22:54:48 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_mpif - a portable interface to the MPI "mpif.h" COMMONs.
+!
+! !DESCRIPTION:
+!
+!   The purpose of \verb"m_mpif" module is to provide a portable
+!   interface of \verb"mpif.h" with different MPI implementation.
+!   By combining module \verb"m_mpif" and \verb"m_mpif90", it may be
+!   possible to build a Fortran 90 MPI binding module graduately.
+!
+!   Although it is possible to use \verb'include "mpif.h"' directly
+!   in individual modules, it has several problems:
+!   \begin{itemize}
+!   \item It may conflict with either the source code of a {\sl fixed}
+!	format or the code of a {\sl free} format;
+!   \item It does not provide the protection and the safety of using
+!	these variables as what a \verb"MODULE" would provide.
+!   \end{itemize}
+!
+!   More information may be found in the module \verb"m_mpif90".
+!
+! !INTERFACE:
+
+	module m_mpif
+	  implicit none
+	  private	! except
+
+	  public :: MPI_INTEGER
+	  public :: MPI_REAL
+	  public :: MPI_DOUBLE_PRECISION
+	  public :: MPI_LOGICAL
+	  public :: MPI_CHARACTER
+
+	  public :: MPI_REAL4
+	  public :: MPI_REAL8
+
+	  public :: MPI_COMM_WORLD
+	  public :: MPI_COMM_NULL
+
+	  public :: MPI_SUM
+	  public :: MPI_PROD
+	  public :: MPI_MIN
+  	  public :: MPI_MAX
+
+	  public :: MPI_MAX_ERROR_STRING
+	  public :: MPI_STATUS_SIZE
+	  public :: MPI_ANY_SOURCE
+
+#ifdef MPICH_
+	  public :: MPIPRIV	! the common block name
+#endif
+
+	  include "mpif.h"
+
+! !REVISION HISTORY:
+! 	01Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+	character(len=*),parameter :: myname='MCT(MPEU)::m_mpif'
+
+	end module m_mpif
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif90.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif90.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpif90.F90	(revision 4775)
@@ -0,0 +1,719 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_mpif90.F90,v 1.3 2002-08-22 23:14:52 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_mpif90 - a Fortran 90 style MPI module interface.
+!
+! !DESCRIPTION:
+!
+!   By wrapping \verb'include "mpif.h"' into a module, \verb"m_mpif()"
+!   provides an easy way to
+!\begin{itemize}
+!  \item avoid the problem with {\sl fixed} or {\sl free} formatted
+!	Fortran 90 files;
+!  \item provide protections with only a limited set of \verb"PUBLIC"
+!	variables; and
+!  \item be extended to a MPI Fortran 90 binding.
+!\end{itemize}
+!
+! !INTERFACE:
+
+    module m_mpif90
+      use m_mpif, only : MP_INTEGER	=> MPI_INTEGER
+      use m_mpif, only : MP_REAL	=> MPI_REAL
+      use m_mpif, only : MP_DOUBLE_PRECISION	&
+					=> MPI_DOUBLE_PRECISION
+      use m_mpif, only : MP_LOGICAL	=> MPI_LOGICAL
+      use m_mpif, only : MP_CHARACTER	=> MPI_CHARACTER
+
+      use m_mpif, only : MP_REAL4	=> MPI_REAL4
+      use m_mpif, only : MP_REAL8	=> MPI_REAL8
+
+      use m_mpif, only : MP_COMM_WORLD	=> MPI_COMM_WORLD
+      use m_mpif, only : MP_COMM_NULL	=> MPI_COMM_NULL
+      use m_mpif, only : MP_SUM		=> MPI_SUM
+      use m_mpif, only : MP_PROD	=> MPI_PROD
+      use m_mpif, only : MP_MIN 	=> MPI_MIN
+      use m_mpif, only : MP_MAX 	=> MPI_MAX
+      use m_mpif, only : MP_MAX_ERROR_STRING	&
+					=> MPI_MAX_ERROR_STRING
+      use m_mpif, only : MP_STATUS_SIZE => MPI_STATUS_SIZE
+      use m_mpif, only : MP_ANY_SOURCE	=> MPI_ANY_SOURCE
+
+      implicit none
+      private
+
+      public :: MP_type
+
+      public :: MP_INTEGER
+      public :: MP_REAL
+      public :: MP_DOUBLE_PRECISION
+      public :: MP_LOGICAL
+      public :: MP_CHARACTER
+
+      public :: MP_REAL4
+      public :: MP_REAL8
+
+      public :: MP_COMM_WORLD
+      public :: MP_COMM_NULL
+
+      public :: MP_SUM
+      public :: MP_PROD
+      public :: MP_MIN
+      public :: MP_MAX
+
+      public :: MP_ANY_SOURCE
+
+      public :: MP_MAX_ERROR_STRING
+
+      public :: MP_init
+      public :: MP_initialized
+      public :: MP_finalize
+      public :: MP_abort
+
+      public :: MP_wtime
+      public :: MP_wtick
+
+      public :: MP_comm_size
+      public :: MP_comm_rank
+      public :: MP_comm_dup
+      public :: MP_comm_free
+
+      public :: MP_cart_create
+      public :: MP_dims_create
+      public :: MP_cart_coords
+      public :: MP_cart_rank
+
+      public :: MP_error_string
+
+      public :: MP_perr
+
+      public :: MP_STATUS_SIZE
+      public :: MP_status
+
+      public :: MP_log2
+
+! !REVISION HISTORY:
+! 	09Dec97 - Jing Guo <guo@thunder> - initial prototyping/coding.
+!		. started with everything public, without any interface
+!		  declaration.
+!		. Then limited to only variables current expected to
+!		  be used.
+!	
+!EOP
+!_______________________________________________________________________
+
+integer,dimension(MP_STATUS_SIZE) :: MP_status
+
+	!----------------------------------------
+
+interface MP_init
+  subroutine MPI_init(ier)
+    integer,intent(out) :: ier
+  end subroutine MPI_init
+end interface
+
+interface MP_initialized
+  subroutine MPI_initialized(flag,ier)
+    logical,intent(out) :: flag
+    integer,intent(out) :: ier
+  end subroutine MPI_initialized
+end interface
+
+interface MP_finalize
+  subroutine MPI_finalize(ier)
+    integer,intent(out) :: ier
+  end subroutine MPI_finalize
+end interface
+
+interface MP_error_string
+  subroutine MPI_error_string(ierror,cerror,ln,ier)
+    integer,intent(in) :: ierror
+    character(len=*),intent(out) :: cerror
+    integer,intent(out) :: ln
+    integer,intent(out) :: ier
+  end subroutine MPI_error_string
+end interface
+
+interface MP_type; module procedure	&
+  typeI_,	& ! MPI_INTEGER
+  typeL_,	& ! MPI_LOGICAL
+  typeC_,	& ! MPI_CHARACTER
+  typeSP_,	& ! MPI_REAL
+  typeDP_,	& ! MPI_DOUBLE_PRECISION
+  typeI1_,	& ! MPI_INTEGER
+  typeL1_,	& ! MPI_LOGICAL
+  typeC1_,	& ! MPI_CHARACTER
+  typeSP1_,	& ! MPI_REAL
+  typeDP1_,	& ! MPI_DOUBLE_PRECISION
+  typeI2_,	& ! MPI_INTEGER
+  typeL2_,	& ! MPI_LOGICAL
+  typeC2_,	& ! MPI_CHARACTER
+  typeSP2_,	& ! MPI_REAL
+  typeDP2_	  ! MPI_DOUBLE_PRECISION
+end interface
+
+interface MP_perr; module procedure perr_; end interface
+
+interface MP_abort
+  subroutine MPI_abort(comm,errorcode,ier)
+    integer,intent(in) :: comm
+    integer,intent(in) :: errorcode
+    integer,intent(out) :: ier
+  end subroutine MPI_abort
+end interface
+
+	!----------------------------------------
+interface MP_wtime
+  function MPI_wtime()
+    double precision :: MPI_wtime
+  end function MPI_wtime
+end interface
+
+interface MP_wtick
+  function MPI_wtick()
+    double precision :: MPI_wtick
+  end function MPI_wtick
+end interface
+
+	!----------------------------------------
+interface MP_comm_size
+  subroutine MPI_comm_size(comm,size,ier)
+    integer,intent(in) :: comm
+    integer,intent(out) :: size
+    integer,intent(out) :: ier
+  end subroutine MPI_comm_size
+end interface
+
+interface MP_comm_rank
+  subroutine MPI_comm_rank(comm,rank,ier)
+    integer,intent(in) :: comm
+    integer,intent(out) :: rank
+    integer,intent(out) :: ier
+  end subroutine MPI_comm_rank
+end interface
+
+interface MP_comm_dup
+  subroutine MPI_comm_dup(comm,newcomm,ier)
+    integer,intent(in) :: comm
+    integer,intent(out) :: newcomm
+    integer,intent(out) :: ier
+  end subroutine MPI_comm_dup
+end interface
+
+interface MP_comm_free
+  subroutine MPI_comm_free(comm,ier)
+    integer,intent(inout) :: comm
+    integer,intent(out) :: ier
+  end subroutine MPI_comm_free
+end interface
+
+	!----------------------------------------
+interface MP_cart_create
+  subroutine MPI_cart_create(comm_old,ndims,dims,periods,	&
+  	reorder,comm_cart,ier)
+    integer,intent(in) :: comm_old
+    integer,intent(in) :: ndims
+    integer,dimension(*),intent(in) :: dims
+    logical,dimension(*),intent(in) :: periods
+    logical,             intent(in) :: reorder
+    integer,intent(out) :: comm_cart
+    integer,intent(out) :: ier
+  end subroutine MPI_cart_create
+end interface
+
+interface MP_dims_create
+  subroutine MPI_dims_create(nnodes,ndims,dims,ier)
+    integer,intent(in) :: nnodes
+    integer,intent(in) :: ndims
+    integer,dimension(*),intent(inout) :: dims
+    integer,intent(out) :: ier
+  end subroutine MPI_dims_create
+end interface
+
+interface MP_cart_coords
+  subroutine MPI_cart_coords(comm,rank,maxdims,coords,ier)
+    integer,intent(in) :: comm
+    integer,intent(in) :: rank
+    integer,intent(in) :: maxdims
+    integer,dimension(*),intent(out) :: coords
+    integer,intent(out) :: ier
+  end subroutine MPI_cart_coords
+end interface
+
+interface MP_cart_rank
+  subroutine MPI_cart_rank(comm,coords,rank,ier)
+    integer,intent(in) :: comm
+    integer,dimension(*),intent(in) :: coords
+    integer,intent(out) :: rank
+    integer,intent(out) :: ier
+  end subroutine MPI_cart_rank
+end interface
+	!----------------------------------------
+
+  character(len=*),parameter :: myname='m_mpif90'
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeI_ - return MPI datatype of INTEGER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeI_(ival)
+      implicit none
+      integer,intent(in) :: ival
+      integer :: typeI_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeI_'
+
+  typeI_=MP_INTEGER
+
+end function typeI_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeL_ - return MPI datatype of LOGICAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeL_(lval)
+      implicit none
+      logical,intent(in) :: lval
+      integer :: typeL_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeL_'
+
+  typeL_=MP_LOGICAL
+
+end function typeL_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeC_ - return MPI datatype of CHARACTER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeC_(cval)
+      implicit none
+      character(len=*),intent(in) :: cval
+      integer :: typeC_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeC_'
+
+  typeC_=MP_CHARACTER
+
+end function typeC_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeSP_ - return MPI datatype of single precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeSP_(rval)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),intent(in) :: rval
+      integer :: typeSP_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeSP_'
+
+  typeSP_=MP_REAL
+
+end function typeSP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeDP_ - return MPI datatype of double precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeDP_(rval)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),intent(in) :: rval
+      integer :: typeDP_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeDP_'
+
+  typeDP_=MP_DOUBLE_PRECISION
+
+end function typeDP_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeI1_ - return MPI datatype of INTEGER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeI1_(ival)
+      implicit none
+      integer,dimension(:),intent(in) :: ival
+      integer :: typeI1_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeI1_'
+
+  typeI1_=MP_INTEGER
+
+end function typeI1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeL1_ - return MPI datatype of LOGICAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeL1_(lval)
+      implicit none
+      logical,dimension(:),intent(in) :: lval
+      integer :: typeL1_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeL1_'
+
+  typeL1_=MP_LOGICAL
+
+end function typeL1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeC1_ - return MPI datatype of CHARACTER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeC1_(cval)
+      implicit none
+      character(len=*),dimension(:),intent(in) :: cval
+      integer :: typeC1_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeC1_'
+
+  typeC1_=MP_CHARACTER
+
+end function typeC1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeSP1_ - return MPI datatype of single precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeSP1_(rval)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:),intent(in) :: rval
+      integer :: typeSP1_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeSP1_'
+
+  typeSP1_=MP_REAL
+
+end function typeSP1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeDP1_ - return MPI datatype of double precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeDP1_(rval)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:),intent(in) :: rval
+      integer :: typeDP1_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeDP1_'
+
+  typeDP1_=MP_DOUBLE_PRECISION
+
+end function typeDP1_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeI2_ - return MPI datatype of INTEGER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeI2_(ival)
+      implicit none
+      integer,dimension(:,:),intent(in) :: ival
+      integer :: typeI2_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeI2_'
+
+  typeI2_=MP_INTEGER
+
+end function typeI2_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeL2_ - return MPI datatype of LOGICAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeL2_(lval)
+      implicit none
+      logical,dimension(:,:),intent(in) :: lval
+      integer :: typeL2_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeL2_'
+
+  typeL2_=MP_LOGICAL
+
+end function typeL2_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeC2_ - return MPI datatype of CHARACTER
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeC2_(cval)
+      implicit none
+      character(len=*),dimension(:,:),intent(in) :: cval
+      integer :: typeC2_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeC2_'
+
+  typeC2_=MP_CHARACTER
+
+end function typeC2_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeSP2_ - return MPI datatype of single precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeSP2_(rval)
+      use m_realkinds,only : SP
+      implicit none
+      real(SP),dimension(:,:),intent(in) :: rval
+      integer :: typeSP2_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeSP2_'
+
+  typeSP2_=MP_REAL
+
+end function typeSP2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: typeDP2_ - return MPI datatype of double precision REAL
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function typeDP2_(rval)
+      use m_realkinds,only : DP
+      implicit none
+      real(DP),dimension(:,:),intent(in) :: rval
+      integer :: typeDP2_
+
+! !REVISION HISTORY:
+! 	28Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::typeDP2_'
+
+  typeDP2_=MP_DOUBLE_PRECISION
+
+end function typeDP2_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: perr_ - MPI error information hanlder
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine perr_(proc,MP_proc,ierror)
+      use m_stdio, only : stderr
+      implicit none
+      character(len=*),intent(in) :: proc
+      character(len=*),intent(in) :: MP_proc
+      integer,intent(in) :: ierror
+
+! !REVISION HISTORY:
+! 	21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::perr_'
+
+  character(len=MP_MAX_ERROR_STRING) :: estr
+  integer :: ln,ier
+
+  call MP_error_string(ierror,estr,ln,ier)
+  if(ier /= 0 .or. ln<=0) then
+    write(stderr,'(4a,i4)') proc,': ',	&
+	MP_proc,' error, ierror =',ierror
+  else
+    write(stderr,'(6a)') proc,': ',	&
+	MP_proc,' error, "',estr(1:ln),'"'
+  endif
+
+end subroutine perr_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: MP_log2 - The smallest integer its power of 2 is >= nPE
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function MP_log2(nPE)
+      implicit none
+      integer,intent(in) :: nPE
+      integer :: MP_log2
+
+! !REVISION HISTORY:
+! 	01Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::MP_log2'
+
+  integer :: n2
+
+  MP_log2=0
+  n2=1
+  do while(n2<nPE)
+    MP_log2 = MP_log2+1
+    n2 = n2+n2
+  end do
+
+end function MP_log2
+
+end module m_mpif90
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpout.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpout.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_mpout.F90	(revision 4775)
@@ -0,0 +1,353 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_mpout.F90,v 1.6 2007-01-02 23:00:42 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_mpout - a multiple but mergable parallel output module
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_mpout
+      use m_stdio, only : stdout,LEN_FILENAME
+      implicit none
+      private	! except
+
+      public :: mpout	! The file handle as a Fortran logical unit
+
+      public :: mpout_open	! open the multiple output streams
+      public :: mpout_close	! close the multiple output streams
+      public :: mpout_sync	! sync. the multiple output streams
+      public :: mpout_flush	! flush the multople output streams
+      public :: mpout_ison	! verify if mpout is proper defined
+      public :: mpout_log	! write a message to mpout
+
+      interface mpout_open;  module procedure open_;  end interface
+      interface mpout_close; module procedure close_; end interface
+      interface mpout_sync;  module procedure sync_;  end interface
+      interface mpout_flush; module procedure flush_; end interface
+      interface mpout_ison;  module procedure ison_;  end interface
+      interface mpout_log
+          module procedure log1_
+          module procedure log2_
+      end interface
+
+! !REVISION HISTORY:
+! 	25Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!	28Sep99 - Jing Guo <guo@thunder>
+!		- Added additional calls to support the "Violet" system
+!		  development.
+!
+! !DESIGN ISSUES:
+! \begin{itemize}
+!
+! \item	It might be considered useful to implement this module to be
+!	applicable to a given {\sl communicator}.   The argument
+!	taken now is to only have one multiple output stream handle
+!	per excution.  This is consistent with \verb"stdout" in the
+!	traditional sense. (Jing Guo, 25Feb98)
+!
+! \item \verb"mpout_log()" is implemented in a way producing output
+!	only if \verb"mpout_ison()" (being \verb".true.").  The reason
+!	of not implementing a default output such as \verb"stdout", is
+!	hoping to provent too many unexpected output when the system is
+!	switched to a multiple PE system.  The design principle for
+!	this module is that \verb"mpout" is basically {\sl not} the same
+!	module as \verb"stdout". (Jing Guo, 28Sep99)
+!
+! \end{itemize}
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_mpout'
+
+  character(len=*),parameter :: def_pfix='mpout'
+
+  integer,save :: isec=-1
+  integer,save :: mpout=stdout
+  logical,save :: mpout_set=.false.
+  character(len=LEN_FILENAME-4),save :: upfix=def_pfix
+  integer,parameter :: mpout_MASK=3	! every four PEs
+
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: open_ - open a multiple files with the same name prefix
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine open_(mask,pfix)
+      use m_stdio, only : stderr,stdout
+      use m_ioutil, only : luavail,opntext
+      use m_dropdead, only : die
+      use m_mpif90, only : MP_comm_WORLD
+      use m_mpif90, only : MP_comm_rank
+      use m_mpif90, only : MP_perr
+      implicit none
+      integer,optional,intent(in) :: mask
+      character(len=*),optional,intent(in) :: pfix
+
+! !EXAMPLES:
+!
+!   Examples of using mpout_MASK or mask:
+!
+!	If the mask has all "1" in every bit, there will be no output
+!   on every PE, except the PE of rank 0.
+!
+!	If the mask is 3 or "11"b, any PE of rank with any "dirty" bit
+!   in its rank value will not have output.
+! 
+! !REVISION HISTORY:
+! 	25Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::open_'
+  integer :: lu
+  character(len=4) :: sfix
+  integer :: irank
+  integer :: ier
+  integer :: umask
+
+	! Set the filename prefix
+
+  upfix=def_pfix
+  if(present(pfix)) upfix=pfix
+
+	! Set the mask of the PEs with mpout
+
+  umask=mpout_MASK
+  if(present(mask)) umask=mask
+
+	! If a check is not in place, sent the outputs to stdout
+
+  mpout=stdout
+  mpout_set=.false.
+
+  call MP_comm_rank(MP_comm_world,irank,ier)
+  if(ier /= 0) then
+    call MP_perr(myname_,'MP_comm_rank()',ier)
+    call die(myname_)
+  endif
+
+  if(iand(irank,umask) == 0) then
+
+    lu=luavail()
+    if(lu > 0) mpout=lu
+
+    write(sfix,'(a,z3.3)') '.',irank
+    call opntext(mpout,trim(upfix)//sfix,'unknown',ier)
+    if(ier /= 0) then
+      write(stderr,'(4a,i4)') myname_,	&
+	': opntext("',trim(upfix)//sfix,'") error, ier =',ier
+      call die(myname_)
+    endif
+
+    mpout_set=.true.
+
+    isec=0
+    write(mpout,'(a,z8.8,2a)') '.BEGIN.  ',isec,' ',trim(upfix)
+  endif
+
+end subroutine open_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: close_ - close the unit opened by open_
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine close_()
+      use m_stdio,  only : stderr
+      use m_ioutil, only : clstext, luflush
+      use m_dropdead, only : die
+      implicit none
+
+! !REVISION HISTORY:
+! 	25Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::close_'
+  integer :: ier
+
+  if(mpout_set) then
+    call luflush(mpout)
+
+    isec=isec+1
+    write(mpout,'(a,z8.8,2a)') '.END.    ',isec,' ',trim(upfix)
+    endfile(mpout)
+
+    call clstext(mpout,ier)
+    if(ier /= 0) then
+      write(stderr,'(2a,i3.3,a,i4)') myname_,	&
+	': clstext("',mpout,'") error, ier =',ier
+      call die(myname_)
+    endif
+    mpout=stdout
+    mpout_set=.false.
+  endif
+
+  isec=-1
+
+end subroutine close_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: sync_ - write a mark for posible later file merging
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine sync_(tag)
+      use m_stdio,    only : stderr
+      use m_dropdead, only : die
+      implicit none
+      character(len=*),intent(in) :: tag
+
+! !REVISION HISTORY:
+! 	25Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!
+! !DESIGN ISSUES:
+! \begin{itemize}
+!
+! \item	Should the variable \verb"tag" be implemented as an optional
+!	argument?  Because the current implementation does not require
+!	actual synchronization between all threads of the multiple
+!	output streams, forcing the user to supply a unique \verb"tag"
+!	would make the final multi-stream merging verifiable.  However,
+!	since the \verb"tag"s have not been forced to be unique, the
+!	synchronization operations are still symbolic.
+!	
+! \{itemize}
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::sync_'
+
+  if(mpout_set) then
+    isec=isec+1
+    write(mpout,'(a,z8.8,2a)') '.SYNC.   ',isec,' ',trim(tag)
+  endif
+
+end subroutine sync_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: flush_ - flush the multiple output streams
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine flush_()
+      use m_stdio, only : stderr
+      use m_ioutil, only : luflush
+      use m_dropdead, only : die
+      implicit none
+
+! !REVISION HISTORY:
+! 	27Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::flush_'
+
+  if(mpout_set) call luflush(mpout)
+
+end subroutine flush_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: ison_ - decide if the current PE has a defined mpout
+!
+! !DESCRIPTION:
+!
+!   It needs to be checked to avoid undesired output.
+!
+! !INTERFACE:
+
+    function ison_()
+      implicit none
+      logical :: ison_
+
+! !REVISION HISTORY:
+! 	14Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::ison_'
+
+  ison_=mpout_set
+
+end function ison_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       ANL/MCS  Mathematics and Computer Science Division             !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: log1_ - write a message to mpout
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine log1_(message)
+      implicit none
+      character(len=*),intent(in) :: message
+
+! !REVISION HISTORY:
+! 	07Jan02	- R. Jacob (jacob@mcs.anl.gov)
+!		- based on log2_.
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::log1_'
+
+  if(mpout_set) write(mpout,'(3a)') message
+
+end subroutine log1_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: log2_ - write a message to mpout with a where
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine log2_(where,message)
+      implicit none
+      character(len=*),intent(in) :: where
+      character(len=*),intent(in) :: message
+
+! !REVISION HISTORY:
+! 	14Sep99	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+! 	07Jan02	- R. Jacob (jacob@mcs.anl.gov)
+!               - change name to log2_
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::log2_'
+
+  if(mpout_set) write(mpout,'(3a)') where,': ',message
+
+end subroutine log2_
+end module m_mpout
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_rankMerge.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_rankMerge.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_rankMerge.F90	(revision 4775)
@@ -0,0 +1,620 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_rankMerge.F90,v 1.3 2004-04-21 22:54:48 jacob Exp
+! CVS MCT_2_8_0  
+!BOP -------------------------------------------------------------------
+!
+! !MODULE: m_rankMerge - A merging tool through ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_rankMerge
+      implicit none
+      private	! except
+
+      public :: rankSet		! set inital ranks
+      public :: rankMerge	! merge two ranks
+      public :: IndexedRankMerge ! index-merge two array segments
+
+      interface rankSet; module procedure set_; end interface
+
+      interface rankMerge; module procedure	&
+	imerge_,	&	! rank-merging two integer arrays
+	rmerge_,	&	! rank-merging two real arrays
+	dmerge_,	&	! rank-merging two dble arrays
+	uniq_			! merging to rank arrays
+      end interface
+
+      interface IndexedRankMerge; module procedure	&
+	iindexmerge_,	&	! merging two index arrays of integers
+	rindexmerge_,	&	! merging two index arrays of reals
+	dindexmerge_		! merging two index arrays of dbles
+      end interface
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname='MCT(MPEU)::m_rankMerge'
+
+contains
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: set_ - set initial ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine set_(rank)
+      implicit none
+      integer,dimension(:),intent(out) :: rank
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::set_'
+  integer :: i
+
+  do i=1,size(rank)
+    rank(i)=0
+  end do
+
+end subroutine set_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: imerge_ - merge two sorted integer arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine imerge_(value_i,value_j,krank_i,krank_j,descend)
+      implicit none
+
+      integer,dimension(:),intent(in)    :: value_j	! value of j-vec
+      integer,dimension(:),intent(in)    :: value_i	! value of i-vec
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::imerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  integer :: value_sv,value
+  integer :: krank
+  integer :: i,j
+
+  descend_=.false.
+  if(present(descend)) descend_=descend
+  
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+          value = value_i(i)
+        else			! .eqv. j<=nj
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+            value = value_i(i)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value_i(i)<=value_j(j)
+              if(descend_) geti = value_i(i)>=value_j(j)
+            endif
+          endif
+          if(.not.geti) value = value_j(j)
+        endif
+
+        if(krank==0 .or. value /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine imerge_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rmerge_ - merge two sorted real arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine rmerge_(value_i,value_j,krank_i,krank_j,descend)
+      use m_realkinds, only : SP
+      implicit none
+
+      real(SP),dimension(:),intent(in)    :: value_i	! value of i-vec
+      real(SP),dimension(:),intent(in)    :: value_j	! value of j-vec
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rmerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  real(SP)    :: value_sv,value
+  integer :: krank
+  integer :: i,j
+  
+  descend_=.false.
+  if(present(descend)) descend_=descend
+
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+          value = value_i(i)
+        else			! .eqv. j<=nj
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+            value = value_i(i)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value_i(i)<=value_j(j)
+              if(descend_) geti = value_i(i)>=value_j(j)
+            endif
+          endif
+          if(.not.geti) value = value_j(j)
+        endif
+        
+        if(krank==0 .or. value /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine rmerge_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dmerge_ - merge two sorted real arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine dmerge_(value_i,value_j,krank_i,krank_j,descend)
+      use m_realkinds, only : DP
+      implicit none
+
+      real(DP),dimension(:),intent(in)    :: value_i	! value of i-vec
+      real(DP),dimension(:),intent(in)    :: value_j	! value of j-vec
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::dmerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  real(DP):: value_sv,value
+  integer :: krank
+  integer :: i,j
+  
+  descend_=.false.
+  if(present(descend)) descend_=descend
+
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+          value = value_i(i)
+        else			! .eqv. j<=nj
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+            value = value_i(i)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value_i(i)<=value_j(j)
+              if(descend_) geti = value_i(i)>=value_j(j)
+            endif
+          endif
+          if(.not.geti) value = value_j(j)
+        endif
+        
+        if(krank==0 .or. value /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine dmerge_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: iindexmerge_ - merge two sorted integer arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine iindexmerge_(indx_i,indx_j,value,krank_i,krank_j,descend)
+      implicit none
+
+      integer,dimension(:),intent(in)    :: indx_i	! of the i-vec
+      integer,dimension(:),intent(in)    :: indx_j	! of the j-vec
+      integer,dimension(:),intent(in)    :: value	! of the full
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::iindexmerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  integer :: value_sv,value_
+  integer :: krank
+  integer :: i,j,li,lj
+
+  descend_=.false.
+  if(present(descend)) descend_=descend
+  
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+	  li=indx_i(i)
+          value_ = value(li)
+        else			! .eqv. j<=nj
+	  lj=indx_j(j)
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+	    li=indx_i(i)
+            value_ = value(li)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value(li)<=value(lj)
+              if(descend_) geti = value(li)>=value(lj)
+            endif
+          endif
+          if(.not.geti) value_ = value(lj)
+        endif
+
+        if(krank==0 .or. value_ /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value_
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine iindexmerge_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: rindexmerge_ - merge two sorted real arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine rindexmerge_(indx_i,indx_j,value,krank_i,krank_j,descend)
+      use m_realkinds,only : SP
+      implicit none
+
+      integer,dimension(:),intent(in)    :: indx_i	! of the i-vec
+      integer,dimension(:),intent(in)    :: indx_j	! of the j-vec
+      real(SP),dimension(:),intent(in)    :: value	! of the full
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::rindexmerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  real(SP):: value_sv,value_
+  integer :: krank
+  integer :: i,j,li,lj
+  
+  descend_=.false.
+  if(present(descend)) descend_=descend
+
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+	  li=indx_i(i)
+          value_ = value(li)
+        else			! .eqv. j<=nj
+	  lj=indx_j(j)
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+	    li=indx_i(i)
+            value_ = value(li)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value(li)<=value(lj)
+              if(descend_) geti = value(li)>=value(lj)
+            endif
+          endif
+          if(.not.geti) value_ = value(lj)
+        endif
+        
+        if(krank==0 .or. value_ /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value_
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine rindexmerge_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: dindexmerge_ - merge two sorted real arrays by ranking
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine dindexmerge_(indx_i,indx_j,value,krank_i,krank_j,descend)
+      use m_realkinds,only : DP
+      implicit none
+
+      integer,dimension(:),intent(in)    :: indx_i	! of the i-vec
+      integer,dimension(:),intent(in)    :: indx_j	! of the j-vec
+      real(DP),dimension(:),intent(in)    :: value	! of the full
+
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+      logical,optional,intent(in) :: descend
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::dindexmerge_'
+
+  integer :: ni,nj
+  logical :: descend_
+  logical :: geti
+  real(DP):: value_sv,value_
+  integer :: krank
+  integer :: i,j,li,lj
+  
+  descend_=.false.
+  if(present(descend)) descend_=descend
+
+  ni=size(krank_i)
+  nj=size(krank_j)
+  
+  i=1
+  j=1
+  krank=0		! a preset rank value
+  value_sv=0
+
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+	  li=indx_i(i)
+          value_ = value(li)
+        else			! .eqv. j<=nj
+	  lj=indx_j(j)
+          geti = i<=ni
+          if(geti) then         ! .eqv. i<=ni
+	    li=indx_i(i)
+            value_ = value(li)
+            geti = krank_i(i) <= krank_j(j)
+            if(krank_i(i)==krank_j(j)) then
+              geti = value(li)<=value(lj)
+              if(descend_) geti = value(li)>=value(lj)
+            endif
+          endif
+          if(.not.geti) value_ = value(lj)
+        endif
+        
+        if(krank==0 .or. value_ /= value_sv) then
+          krank=krank+1		! the next rank value
+          value_sv=value_
+        endif
+        
+        if(geti) then
+          krank_i(i)=krank
+          i=i+1
+        else
+          krank_j(j)=krank
+          j=j+1
+        endif
+  end do
+
+end subroutine dindexmerge_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!BOP -------------------------------------------------------------------
+!
+! !IROUTINE: uniq_ - merge two rank arrays with unique rank values
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine uniq_(krank_i,krank_j)
+      implicit none
+      integer,dimension(:),intent(inout) :: krank_i	! rank of i-vec
+      integer,dimension(:),intent(inout) :: krank_j	! rank of j-vec
+
+! !REVISION HISTORY:
+! 	13Mar00	- Jing Guo <guo@dao.gsfc.nasa.gov>
+!		- initial prototype/prolog/code
+!EOP ___________________________________________________________________
+
+  character(len=*),parameter :: myname_=myname//'::uniq_'
+
+  integer :: ni,nj
+  integer :: i,j
+  integer :: krank
+  logical :: geti
+
+  ni=size(krank_i)
+  nj=size(krank_j)
+
+  i=1
+  j=1
+  krank=0
+  do
+        geti=j>nj
+        if(geti) then		! .eqv. j>nj
+          if(i>ni) exit		! i>ni
+        else			! .eqv. j<=nj
+          geti = i<=ni
+          if(geti) geti = krank_i(i) <= krank_j(j)	! if(i<=ni) ..
+        endif
+        
+        krank=krank+1		! the next rank value
+
+	if(geti) then
+	  krank_i(i)=krank
+	  i=i+1
+	else
+	  krank_j(j)=krank
+	  j=j+1
+	endif
+  end do
+
+end subroutine uniq_
+
+end module m_rankMerge
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_realkinds.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_realkinds.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_realkinds.F90	(revision 4775)
@@ -0,0 +1,52 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_realkinds.F90,v 1.6 2004-04-21 22:54:48 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_realkinds - real KIND definitions
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_realkinds
+      implicit none
+      private	! except
+
+      public :: kind_r4		! real*4
+      public :: kind_r8		! real*8
+      public :: kind_r		! default real
+      public :: SP		! default REAL
+      public :: DP		! default DOUBLE_PRECISION
+      public :: FP		! general floating point precision
+
+      real*4,parameter :: mpeuR4=1.
+      real*8,parameter :: mpeuR8=1.
+      real,  parameter :: mpeuR =1.
+
+#ifdef SELECTEDREALKIND
+      integer,parameter :: SP = selected_real_kind( 6)  ! 32-bit real, on most platforms
+      integer,parameter :: DP = selected_real_kind(12)  ! 64-bit real, on most platforms
+#else
+      integer,parameter :: SP = kind(1.  )
+      integer,parameter :: DP = kind(1.D0)
+#endif
+
+!     Set the current default floating point precision 
+      integer,parameter :: FP = DP
+
+      integer,parameter :: kind_r4=kind(mpeuR4)
+      integer,parameter :: kind_r8=kind(mpeuR8)
+      integer,parameter :: kind_r =kind(mpeuR )
+
+! !REVISION HISTORY:
+! 	19Feb98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	23Jan03 - R. Jacob <jacob@mcs.anl.gov> - add FP
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_realkinds'
+
+end module m_realkinds
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_stdio.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_stdio.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_stdio.F90	(revision 4775)
@@ -0,0 +1,53 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_stdio.F90,v 1.3 2002-08-22 23:14:53 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_stdio - a F90 module defines std. I/O parameters
+!
+! !DESCRIPTION:
+!	Define system dependent I/O parameters.
+!
+! !INTERFACE:
+
+	module m_stdio
+	implicit none
+	private
+
+	public	:: stdin	! a unit linked to UNIX stdin
+	public	:: stdout	! a unit linked to UNIX stdout
+	public	:: stderr	! a unit linked to UNIX stderr
+
+	public	:: LEN_FILENAME
+
+! !REVISION HISTORY:
+!	10oct96 - Jing G.	- Defined
+!       25Jul02 - J. Larson     - Changed cpp define token HP-UX to
+!                                 HP_UX for compatibility with Fujitsu
+!                                 cpp.
+!EOP
+!_______________________________________________________________________
+
+!    Defines standar i/o units.
+
+	integer, parameter :: stdin  = 5
+	integer, parameter :: stdout = 6
+
+#ifdef	sysHP_UX
+		! Special setting for HP-UX
+
+	integer, parameter :: stderr = 7
+#else
+		! Generic setting for UNIX other than HP-UX
+
+	integer, parameter :: stderr = 0
+#endif
+
+	integer, parameter :: LEN_FILENAME = 128
+
+!-----------------------------------------------------------------------
+end module m_stdio
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_zeit.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_zeit.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_zeit.F90	(revision 4775)
@@ -0,0 +1,1008 @@
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+! CVS m_zeit.F90,v 1.10 2004-04-21 22:54:49 jacob Exp
+! CVS MCT_2_8_0  
+!-----------------------------------------------------------------------
+!BOP
+!
+! !MODULE: m_zeit - a multi-timer of process times and wall-clock times
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    module m_zeit
+      implicit none
+      private	! except
+
+      public :: zeit_ci		! push a new name to the timer
+      public :: zeit_co		! pop the current name on the timer
+      public :: zeit_flush	! print per PE timing
+      public :: zeit_allflush	! print all PE timing
+      public :: zeit_reset	! reset the timers to its initial state
+
+	! Flags of all printable timers
+
+      public ::  MWTIME	! MPI_Wtime() wall-clock time
+      public ::  XWTIME	! times() wall-clock time
+      public ::  PUTIME	! times() process user time
+      public ::  PSTIME	! times() process system time
+      public ::  CUTIME	! times() user time of all child-processes
+      public ::  CSTIME	! times() system time of all child-processes
+      public :: ALLTIME	! all of above
+      public ::  UWRATE ! (putime+cutime)/xwtime
+
+      interface zeit_ci;    module procedure ci_;    end interface
+      interface zeit_co;    module procedure co_;    end interface
+      interface zeit_flush; module procedure flush_; end interface
+      interface zeit_allflush; module procedure allflush_; end interface
+      interface zeit_reset; module procedure reset_; end interface
+
+! !REVISION HISTORY:
+!
+! 	22Jan01 - Jay Larson <larson@mcs.anl.gov> - Minor correction in
+!                 write statements in the routines sp_balances_() and
+!                 mp_balances_():  replaced x (single-space) descriptor
+!                 with 1x.  This is apparently strict adherance to the
+!                 f90 standard (though the first of many, many compilers
+!                 where it has arisen).  This was for the SunOS platform.
+! 	05Mar98 - Jing Guo <guo@thunder>	-
+!		. rewritten for possible MPI applications, with
+!		  additional functionalities and new performance
+!		  analysis information.
+!		. Interface names have been redefined to ensure all
+!		  use cases to be verified.
+!		. removed the type(pzeit) data structure, therefore,
+!		  limited to single _instance_ applications.
+!		. added additional data components for more detailed
+!		  timing analysis.
+!		. used times() for the XPG4 standard conforming
+!		  timing functions.
+!		. used MPI_Wtime() for the MPI standard conforming
+!		  high-resolution timing functions.
+!
+! 	20Feb97 - Jing Guo <guo@eramus>		-
+!		. rewritten in Fortran 90 as the first modular
+!		  version, with a type(pzeit) data structure.
+!
+!	10may96 - Jing G. -	Add _TZEITS macro for the testing code
+!	09may96 - Jing G. -	Changed output format also modifed
+!				comments
+!	11Oct95 - Jing G. -	Removed earlier way of letting clock
+!				timing (clkknt and clktot) to be no less
+!				then the CPU timing, following a
+!				suggestion by James Abeles from Cray.
+!				This way, users may use the routings to
+!				timing multitasking speedup as well.
+!	12May95	- Jing G. -	Merged zeitCRAY.f and zeitIRIS.f.
+!	Before	- ?	  -	See zeitCRAY.f and zeitIRIS.f for more
+!				information.  Authors of those files are
+!				not known to me.
+!
+! !DESIGN ISSUES:
+!
+!	05Mar98	- Jing Guo <guo@thunder>	-
+!		. Removing the data structure may be consider as a 
+!		  limitation to future changes to multiple _instance_
+!		  applications.  However, it is unlikely there will be
+!		  any neccessary multi-_intance_ application soon, if
+!		  ever for this module.
+!		. Without an additional layer with the derived
+!		  datatype, one may worry less the tricky performance
+!		  issues associated with ci_/co_.
+!		. Performance issue with the flush_() calls are not
+!		  considered.
+!
+!	20Feb97	- Jing Guo <guo@eramus>		-
+!		. Currently a single threaded module.  May be easily
+!		  extended to multi-threaded module by adding the name
+!		  of an instance of the class to the argument list.  It
+!		  requires some but very limited interface extensions.
+!		  Right now, the backward compatibility is the main
+!		  issue.
+!
+! 10may96 - Jing Guo <guo@eramus>		-
+!
+!     + This zeit subroutine collection replaces original zeit files
+!	used in PSAS on both systems, UNICOS and IRIX, with following
+!	changes:
+!
+!	      +	Removed the some bugs in zeitCRAY.f that overite the
+!		first user defined name entry in a special situation
+!		(but not being able to correct in zeitCRAY.f).
+!
+!	      + Unified both zeitCRAY.f and zeitIRIS.f in to one file
+!		(this file), that handles system dependency in only
+!		one subroutine syszeit_() with a couple of lines of
+!		differences.
+!
+!	      + Added system CPU time counts for system supporting
+!		the function.
+!
+!	      + Added some error checking and reporting functions.
+!
+!	      + According to zeitCRAY.f, "zeit" is "time" in Germen.
+!		The name is used through the code as another name for
+!		"time".
+!
+!	      + This version does not work for parallelized processes.
+!
+!     + Elapsed time records since the first call are used.  Although
+!	it may loose accuracy when the values of the time records
+!	become large, it will keep the total time values conserved.
+!
+!     +	The accuracy of the elapsed times at a IEEE real*4 accuracy
+!	(ffrac = 2^23 ~= 1.19e-7) should be no worse than +- 1 second
+!	in 97 days, if only the numerical accuracy is considered.
+!
+!     +	The precision of "wall clock" time returned by syszeit_() is
+!	only required to be reliable upto seconds.
+!
+!     +	The wall clock time for individual name tag (clkknt) is
+!	accumulated by adding the differences between two integer
+!	values, iclk and iclksv.  Care must be taken to compute the
+!	differences of iclk and iclksv first.  That is, doing
+!
+!		clkknt()=clkknt() + (iclk-iclksv)
+!
+!	not
+!
+!		clkknt()=clkknt() + iclk-iclksv
+!
+!	The latter statement may ignore the difference between the two
+!	integer values (iclk and iclksv).
+!
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname='MCT(MPEU)::m_zeit'
+
+  integer,parameter ::  MWTIME =  1
+  integer,parameter ::  XWTIME =  2
+  integer,parameter ::  PUTIME =  4
+  integer,parameter ::  PSTIME =  8
+  integer,parameter ::  CUTIME = 16
+  integer,parameter ::  CSTIME = 32
+  integer,parameter :: ALLTIME = MWTIME + XWTIME + PUTIME +	&
+				 PSTIME + CUTIME + CSTIME
+  integer,parameter ::  UWRATE = 64
+
+  integer,parameter :: MASKS(0:5) =	&
+	(/ MWTIME,XWTIME,PUTIME,PSTIME,CUTIME,CSTIME /)
+
+  character(len=*),parameter :: ZEIT='.zeit.'
+  character(len=8),parameter :: HEADER(0:5) =	&
+    (/	'[MWTIME]','[XWTIME]','[PUTIME]',	&
+	'[PSTIME]','[CUTIME]','[CSTIME]'	/)
+  character(len=8),parameter :: UWRHDR = '[UWRATE]'
+
+  integer,parameter :: MXN= 250	! the size of a name list
+! integer,parameter :: NSZ= 32	! the size of a name
+! LPC jun/6/2000
+  integer,parameter :: NSZ= 36	! the size of a name
+  integer,parameter :: MXS= 64	! the depth of the timer stack
+
+  integer,save :: nreset=0
+  logical,save :: started=.false.
+  logical,save :: balanced=.false.
+
+  character(len=NSZ),	&
+	  save :: ciname=' '
+  character(len=NSZ),	&
+	  save :: coname=' '
+
+  integer,save :: mxdep=0	! the maximum ndep value recorded
+  integer,save :: ndep=-1	! depth, number of net ci_()
+  integer,save :: lnk_n(0:MXS)	! name index of the depth
+
+  integer,save			:: nname=-1	! number of accounts
+  character(len=NSZ),	&
+	  save,dimension(0:MXN) :: name_l	! the accounts
+  integer,save,dimension(0:MXN)	:: knt_l	! counts of ci_() calls
+  integer,save,dimension(0:MXN) :: level_l	! remaining ci_() counts
+
+  real*8,save,dimension(0:5)	   :: zts_sv	! the last timings
+
+  real*8,save,dimension(0:5,0:MXN) ::  zts_l	! credited to a name
+  real*8,save,dimension(0:5,0:MXN) :: szts_l	! all under the name
+  real*8,save,dimension(0:5,0:MXN) :: szts_sv	! the last ci_ timings
+
+!=======================================================================
+contains
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: ci_ - push an entry into the timer
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine ci_(name)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      use m_mpif90,only : MP_wtime
+      implicit none
+      character(len=*), intent(in) :: name
+
+! !REVISION HISTORY:
+! 	05Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::ci_'
+
+	! Local variables
+
+  real*8,dimension(0:5) :: zts
+  integer :: lname,iname
+  integer :: i
+
+	! Encountered a limitation.  Programming is required
+
+  if(ndep >= MXS) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': stack overflow with "'//trim(name)//'", ndep =',ndep
+    call die(myname_)
+  endif
+
+	!--------------------------------------------------------
+	! Initialize the stack if it is called the first time.
+
+  if(.not.started) call reset_()
+
+	! Get the current _zeits_
+
+  call get_zeits(zts(1))
+  zts(0)=MP_wtime()
+
+	!--------------------------------------------------------
+	! Charge the ticks since the last co_() to the current level
+
+  lname=lnk_n(ndep)
+
+  do i=0,5
+    zts_l(i,lname)=zts_l(i,lname) + zts(i)-zts_sv(i)
+  end do
+
+  do i=0,5
+    zts_sv(i)=zts(i)		! update the record
+  end do
+
+	!--------------------------------------------------------
+	! Is the name already in the list?  Case sensitive and
+	! space maybe sensitive if they are inbeded between non-
+	! space characters.
+	!
+	! If the name is already in the list, the index of the
+	! table entry is given.
+	!
+	! If the name is not in the list, a new entry will be added
+	! to the list, if 1) there is room, and 2) 
+
+  iname=lookup_(name)
+
+	!--------------------------------------------------------
+	! push up the stack level
+
+  ndep=ndep+1
+  if(mxdep <= ndep) mxdep=ndep
+
+  lnk_n(ndep)=iname
+  knt_l(iname)=knt_l(iname)+1
+
+	! Recording the check-in time, if there is no remaining 
+	! levels for the same name.  This is used to handle 
+	! recursive ci_() calls for the same name.
+
+  if(level_l(iname) == 0) then
+    do i=0,5
+      szts_sv(i,iname)=zts_sv(i)
+    end do
+  endif
+
+	! open a level
+
+  level_l(iname)=level_l(iname)+1
+
+end subroutine ci_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: co_ - pop the current level
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine co_(name,tms)
+      use m_stdio, only : stderr
+      use m_die, only : die
+      use m_mpif90,only : MP_wtime
+      implicit none
+      character(len=*), intent(in) :: name	! account name
+      real*8,optional,dimension(0:5,0:1),intent(out) :: tms ! timings
+
+!     The returned variable tms(0:5,0:1) contains two sets of timing
+!   information.  tms(0:5,0) is the NET timing data charged under the
+!   account name only, and tms(0:5,1) is the SCOPE timing data since
+!   the last ci() with the same account name and at the out most level.
+!
+! !REVISION HISTORY:
+! 	11Oct99 - J.W. Larson - <jlarson@dao> explicit definition of 
+!                 tms as real*8
+! 	05Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::co_'
+
+  real*8 :: tms0,tms1
+  real*8,dimension(0:5) :: zts
+  integer :: lname
+  integer :: i
+
+	! Encountered a limitation.  Programming is required
+
+  if(ndep <= 0) then
+    write(stderr,'(2a,i4)') myname_,	&
+	': stack underflow with "'//trim(name)//'", ndep =',ndep
+    call die(myname_)
+  endif
+
+	!--------------------------------------------------------
+	! Initialize the stack if it is called the first time.
+
+  if(.not.started) call reset_()
+
+	! Get the current _zeits_
+
+  call get_zeits(zts(1))
+  zts(0)=MP_wtime()
+
+	! need special handling if ndep is too large or too small.
+
+  lname=lnk_n(ndep)
+  level_l(lname)=level_l(lname)-1	! close a level
+
+  do i=0,5
+      tms0=zts(i)- zts_sv(i)		! NET by the _account_
+      tms1=zts(i)-szts_sv(i,lname)	! within its SCOPE
+
+      zts_l(i,lname)= zts_l(i,lname) + tms0
+
+      if(level_l(lname) == 0)		&
+        szts_l(i,lname)=szts_l(i,lname) + tms1
+
+      zts_sv(i)=zts(i)
+
+      if(present(tms)) then
+
+	! Return the timings of the current call segment
+	!
+	!   tms(:,0) is for the NET timing data, that have been charged
+	!	to this account.
+	!
+	!   tms(:,1) is for the SCOPE timing data since the ci() of the
+	!	same account name at the out most level.
+	!  
+
+        tms(i,0)=tms0
+        tms(i,1)=tms1	! only the sub-segments
+      endif
+  end do
+
+	! Record the unbalanced ci/co.  Name .void. is supplied for
+	! backward compartible calls of pzeitend()
+
+  if(name /= '.void.'.and.balanced) then
+    balanced = lname == MXN .or. name == name_l(lname)
+    if(.not.balanced) then
+      ciname=name_l(lname)
+      coname=name
+    endif
+  endif
+
+	! pop (need special handling of ndep too large or too small.
+
+  ndep=ndep-1
+
+end subroutine co_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: reset_ - reset module m_zeit to an initial state
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine reset_()
+      use m_mpif90,only : MP_wtime
+      implicit none
+
+! !REVISION HISTORY:
+! 	04Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::reset_'
+  integer :: i
+
+	! keep tracking the number of reset_() calls
+
+  nreset=nreset+1
+  started=.true.
+  balanced=.true.
+
+	! Start timing
+
+  call get_zeits(zts_sv(1))
+  zts_sv(0)=MP_wtime()
+
+	! Sign in the module name for the overheads (.eqv. ci_(ZEIT))
+
+  nname=0
+  name_l(nname)=ZEIT
+  knt_l(nname)=1
+
+  ndep =0
+  lnk_n(ndep)=nname
+
+	! Initialize the timers.
+
+  do i=0,5
+     zts_l(i,nname)=0.
+    szts_l(i,nname)=0.
+    szts_sv(i,nname)=zts_sv(i)
+  end do
+  level_l(nname)=1
+
+end subroutine reset_
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: lookup_ search/insert a name
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    function lookup_(name)
+      implicit none
+      character(len=*),intent(in) :: name
+      integer :: lookup_
+
+! !REVISION HISTORY:
+! 	04Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::lookup_'
+
+  logical :: found
+  integer :: ith
+  integer :: i
+
+  ith=-1
+  found=.false.
+  do while(.not.found.and. ith < min(nname,MXN))
+    ith=ith+1
+    found = name == name_l(ith)
+  end do
+
+  if(.not.found) then
+
+    found = nname >= MXN	! Can not handle too many accounts?
+    ith=MXN			! Then use the account for ".foo."
+
+    if(.not.found) then		! Otherwise, add a new account.
+      nname=nname+1
+      ith=nname
+
+      name_l(ith)=name
+      if(ith==MXN) name_l(ith)='.foo.'
+
+	! Initialize a new account
+
+      do i=0,5
+         zts_l(i,ith)=0.
+	szts_l(i,ith)=0.
+      end do
+      level_l(ith)=0
+
+    endif
+  endif
+
+  lookup_=ith
+
+end function lookup_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: flush_ - print the timing data
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine flush_(lu,umask)
+      use m_stdio, only : stderr
+      use m_ioutil, only : luflush
+      use m_die, only : die
+      use m_mpif90,only : MP_wtime
+      implicit none
+      integer,intent(in) :: lu	! logical unit for the output
+      integer,optional,intent(in) :: umask
+
+! !REVISION HISTORY:
+! 	05Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::flush_'
+  integer :: imask
+
+  real*8,dimension(0:5) :: zts
+  integer :: i,ier
+
+	! specify which timer to print
+
+  imask=MWTIME
+  if(present(umask)) imask=umask
+
+	! write a <newline>
+
+  write(lu,*,iostat=ier)
+  if(ier /= 0) then
+    write(stderr,'(2a,i3)') myname_,': can not write(), unit =',lu
+    call die(myname_)
+  endif
+
+  if(.not.balanced) write(lu,'(5a)') myname_,	&
+	': ci/co unbalanced, ',trim(ciname),'/',trim(coname)
+
+  call luflush(lu)
+
+	! latest times, but not closing on any entry
+
+  call get_zeits(zts(1))
+  zts(0)=MP_wtime()
+
+	! Print selected tables
+
+  do i=0,5
+    if(iand(MASKS(i),imask) /= 0)	&
+      call sp_balances_(lu,i,zts(i))
+  end do
+#ifdef TODO
+  if(iand(UWRATE,imask) /= 0) call sp_rate_(lu,zts)
+#endif
+
+  call luflush(lu)
+
+end subroutine flush_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: sp_balances_ - print a table of a given timer
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine sp_balances_(lu,itm,zti)
+      implicit none
+      integer,intent(in) :: lu
+      integer,intent(in) :: itm
+      real*8,intent(in) :: zti
+
+! !REVISION HISTORY:
+! 	06Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	22Jan01 - Jay Larson <larson@mcs.anl.gov> - Minor correction in
+!                 A write statement:  replaced x (single-space) descriptor
+!                 with 1x.  This is apparently strict adherance to the
+!                 f90 standard (though the first of many, many compilers
+!                 where it has arisen).  This was for the SunOS platform.
+! 	24Feb01 - Jay Larson <larson@mcs.anl.gov> - Extra decimal place in
+!                 timing numbers (some reformatting will be necessary).
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::sp_balances_'
+
+  real*8,parameter :: res=.001	! (sec)
+
+  integer,parameter :: lnmax=12
+  character(len=max(NSZ,lnmax)) :: name
+
+  character(len=1) :: tag
+  character(len=4) :: num
+
+  integer :: zt_min,zt_sec
+  integer :: sz_min,sz_sec
+  integer :: l,i,ln
+
+  real*8 :: sz0
+  real*8 :: zt,zt_percent,zt_percall
+  real*8 :: sz,sz_percent
+
+	! The total time is given in the ZEIT bin
+
+  sz0=szts_l(itm,0)
+  if(level_l(0) /= 0) sz0=sz0 + zti - szts_sv(itm,0)
+  sz0=max(res,sz0)
+
+  write(lu,'(a,t14,a,t21,a,t31,a,t52,a)')	&
+    HEADER(itm), 'counts','period',	&
+      'NET    m:s      %',		&
+    'SCOPE    m:s      %'
+
+!23.|....1....|....2....|....3....|....4....|....5....|....6....|....7..
+![MWTIME]    counts period    NET    m:s      %    SCOPE    m:s      %
+!-----------------------------------------------------------------------
+!zeit.      (  3s  3d  3)   333.3   33:33   3.3+   333.3   33:33   3.3+
+!sub           333   33.3   333.3   33:33   3.3%   333.3   33:33   3.3%
+
+  write(lu,'(80a)') ('-',i=1,72)
+  do l=0,min(MXN,nname)
+
+    zt= zts_l(itm,l)
+    sz=szts_l(itm,l)
+    tag='%'
+    if(level_l(l) /= 0) then
+      zt=zt + zti -  zts_sv(itm)
+      sz=sz + zti - szts_sv(itm,l)
+      tag='+'
+    endif
+
+    zt_percall=zt/max(1,knt_l(l))
+
+    zt_percent=100.*zt/sz0
+    sz_percent=100.*sz/sz0
+
+    zt_sec=nint(zt)
+    zt_min=    zt_sec/60
+    zt_sec=mod(zt_sec,60)
+
+    sz_sec=nint(sz)
+    sz_min=    sz_sec/60
+    sz_sec=mod(sz_sec,60)
+
+    name=name_l(l)
+    ln=max(len_trim(name),lnmax)
+
+    select case(l)
+      case(0)
+	write(num,'(i4)') mxdep
+!	write(lu,'(2(a,i3),2a,t26,2(1x,f7.1,1x,i4.2,a,i2.2,1x,f5.1,a))')&
+	write(lu,'(2(a,i3),2a,t26,2(1x,f8.2,1x,i4.2,a,i2.2,1x,f6.2,a))')&
+	  name(1:ln),nreset,'s',ndep,'/',num,		&
+	  zt,zt_min,':',zt_sec,zt_percent,tag,		&
+	  sz,sz_min,':',sz_sec,sz_percent,tag
+
+!	write(lu,'(2a,3(i3,a),t26,2(x,f7.1,x,i4.2,a,i2.2,x,f5.1,a))')&
+!	  name(1:ln),'(',nreset,'s',ndep,'d',mxdep,')',	&
+
+      case default
+        if(len_trim(name) < lnmax)then
+!          write(lu,'(a,1x,i5,1x,f6.1,2(1x,f7.1,1x,i4.2,a,i2.2,1x,f5.1,a))') &
+          write(lu,'(a,1x,i5,1x,f7.2,2(1x,f8.2,1x,i4.2,a,i2.2,1x,f6.2,a))') &
+	  name(1:ln),knt_l(l),zt_percall,	&
+	  zt,zt_min,':',zt_sec,zt_percent,tag,	&
+	  sz,sz_min,':',sz_sec,sz_percent,tag
+        else
+          write(lu,'(a)')name(1:ln)
+!          write(lu,'(13x,i5,1x,f6.1,2(1x,f7.1,1x,i4.2,a,i2.2,1x,f5.1,a))') &
+          write(lu,'(13x,i5,1x,f7.2,2(1x,f8.2,1x,i4.2,a,i2.2,1x,f6.2,a))') &
+          knt_l(l),zt_percall,       &
+	  zt,zt_min,':',zt_sec,zt_percent,tag,	&
+	  sz,sz_min,':',sz_sec,sz_percent,tag
+        endif
+    end select
+
+  end do
+  write(lu,'(80a)') ('-',i=1,72)
+
+end subroutine sp_balances_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: allflush_ - print a summary of all PEs.
+!
+! !DESCRIPTION:
+!
+! !INTERFACE:
+
+    subroutine allflush_(comm,root,lu,umask)
+      use m_stdio, only : stderr
+      use m_ioutil, only : luflush
+      use m_die, only : die
+      use m_mpif90,only : MP_wtime,MP_type
+      use m_mpif90,only : MP_comm_size,MP_comm_rank
+      use m_SortingTools,only : IndexSet,IndexSort
+      implicit none
+      integer,intent(in) :: comm
+      integer,intent(in) :: root
+      integer,intent(in) :: lu
+      integer,optional,intent(in) :: umask
+
+! !REVISION HISTORY:
+! 	09Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::allflush_'
+  integer myID,nPE
+  integer :: imask
+  real*8,dimension(0:5)		  :: zts
+  real*8,dimension(0:5,0:1,0:MXN) :: ztbf
+  real*8,dimension(:,:,:,:),allocatable :: ztmp
+  integer,dimension(0:MXN) :: indx_
+  integer :: mnm
+
+  integer :: i,l
+  integer :: nbf,ier
+  integer :: mp_Type_ztbf
+
+  mp_Type_ztbf=MP_type(ztbf(0,0,0))
+
+  imask=MWTIME
+  if(present(umask)) imask=umask
+
+  if(imask==0) return
+
+  call get_zeits(zts(1))
+  zts(0)=MP_wtime()
+
+	! Update the accounts and prepare for the messages
+
+  mnm=min(MXN,nname)
+  do l=0,mnm
+    do i=0,5
+      ztbf(i,0,l)= zts_l(i,l)
+      ztbf(i,1,l)=szts_l(i,l)
+    end do
+
+    if(level_l(l) /= 0) then
+		! Update the current accounts.
+      do i=0,5
+	ztbf(i,0,l)=ztbf(i,0,l) + zts(i) - zts_sv(i  )
+	ztbf(i,1,l)=ztbf(i,1,l) + zts(i) -szts_sv(i,l)
+      end do
+    endif
+  end do
+  nbf=size(ztbf(0:5,0:1,0:mnm))
+
+  call MP_comm_rank(comm,myID,ier)
+  if(ier /= 0) then
+    write(stderr,'(2a,i3)') myname_,	&
+	': MP_comm_rank() error, ier =',ier
+    call die(myname_)
+  endif
+
+	! An urgent hack for now.  Need to be fixed later.  J.G.
+  indx_(0)=0
+  call IndexSet( nname,indx_(1:mnm))
+  call IndexSort(nname,indx_(1:mnm),name_l(1:mnm))
+
+  if(myID /= root) then
+
+    call MPI_gather((ztbf(0:5,0:1,indx_(0:mnm))),nbf,mp_Type_ztbf, &
+		    ztbf,nbf,mp_Type_ztbf,root,comm,ier	)
+    if(ier /= 0) then
+      write(stderr,'(2a,i3)') myname_,	&
+	': MPI_gather(!root) error, ier =',ier
+      call die(myname_)
+    endif
+
+  else
+
+    call MP_comm_size(comm,nPE,ier)
+    if(ier /= 0) then
+      write(stderr,'(2a,i3)') myname_,	&
+	': MP_comm_size() error, ier =',ier
+      call die(myname_)
+    endif
+
+    allocate(ztmp(0:5,0:1,0:mnm,0:nPE-1),stat=ier)
+    if(ier /= 0) then
+      write(stderr,'(2a,i4)') myname_,	&
+	': allocate(zts) error, stat =',ier
+      call die(myname_)
+    endif
+
+    call MPI_gather((ztbf(0:5,0:1,indx_(0:mnm))),nbf,mp_Type_ztbf, &
+		    ztmp,nbf,mp_Type_ztbf,root,comm,ier	)
+    if(ier /= 0) then
+      write(stderr,'(2a,i3)') myname_,	&
+	': MPI_gather(root) error, ier =',ier
+      call die(myname_)
+    endif
+
+	! write a <newline>
+
+    write(lu,*,iostat=ier)
+    if(ier /= 0) then
+      write(stderr,'(2a,i3)') myname_,': can not write(), unit =',lu
+      call die(myname_)
+    endif
+
+    call luflush(lu)
+
+    do i=0,5
+      if(iand(MASKS(i),imask) /= 0)	&
+	call mp_balances_(lu,i,nPE,ztmp,indx_)
+    end do
+#ifdef  TODO
+    if(iand(UWRATE,imask) /= 0) call mp_rate_(lu,nPE,ztmp)
+#endif
+
+    deallocate(ztmp,stat=ier)
+    if(ier /= 0) then
+      write(stderr,'(2a,i4)') myname_,	&
+	  ': deallocate(zts) error, stat =',ier
+      call die(myname_)
+    endif
+  endif
+
+   call luflush(lu)
+end subroutine allflush_
+
+!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
+!-----------------------------------------------------------------------
+!BOP
+!
+! !IROUTINE: mp_balances_ - summarize the timing data of all PEs
+!
+! !DESCRIPTION:
+!
+! \newcommand{\tb}{\overline{t}}
+!
+!	\verb"mp_balances_"() summarizes the timing data of all PEs
+!   with quantified load balancing measures:
+!   \begin{eqnarray*}
+!	x &=& \frac{\max(t) - \tb}{N\tb}	\times 100\%	\\
+!	i &=& \frac{\max(t) - \tb}{\max(t)}	\times 100\%	\\
+!	r &=& \frac{1}{N\tb} \sum^{t>\tb}{(t-\tb)}
+!		\times 100\%
+!   \end{eqnarray*}
+!   where
+!   \begin{center}
+!     \begin{tabular}{rl}
+!       $t$: & time by any process element			\\
+!     $\tb$: & mean time by all process elements		\\
+!	$x$: & the ma{\bf x}imum percentage load deviation	\\
+!	$i$: & percentage {\bf i}dle process-time or
+!					load {\bf i}mbalance	\\
+!	$r$: & percentage {\bf r}elocatable loads		\\
+!	$N$: & {\bf n}umber of process elements
+!     \end{tabular}
+!   \end{center}
+!
+! !INTERFACE:
+
+    subroutine mp_balances_(lu,itm,nPE,ztmp,indx)
+      implicit none
+      integer,intent(in) :: lu
+      integer,intent(in) :: itm
+      integer,intent(in) :: nPE
+      real*8,dimension(0:,0:,0:,0:),intent(in) :: ztmp
+      integer,dimension(0:),intent(in) :: indx
+
+! !REVISION HISTORY:
+! 	10Mar98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
+! 	22Jan01 - Jay Larson <larson@mcs.anl.gov> - Minor correction in
+!                 A write statement:  replaced x (single-space) descriptor
+!                 with 1x.  This is apparently strict adherance to the
+!                 f90 standard (though the first of many, many compilers
+!                 where it has arisen).  This was for the SunOS platform.
+!       25Feb01 - R. Jacob <jacob@mcs.anl.gov> change number of 
+!                 decimal places from 1 to 4.
+!EOP
+!_______________________________________________________________________
+  character(len=*),parameter :: myname_=myname//'::mp_balances_'
+
+  real*8,parameter :: res=.001	! (sec)
+
+  integer,parameter :: lnmax=12
+  character(len=max(NSZ,lnmax)) :: name
+  character(len=4) :: num
+
+  integer :: i,k,l,ln,lx
+
+	! NET times
+  integer :: ix_o
+  real*8  :: zts_o,zta_o,ztm_o,ztr_o
+  integer :: x_o,i_o,r_o
+
+	! SCOPE times
+  integer :: ix_s
+  real*8  :: zts_s,zta_s,ztm_s,ztr_s
+  integer :: x_s,i_s,r_s
+
+  write(num,'(i4)') nPE
+  write(lu,'(3a,t18,a,t58,a)')	&
+    HEADER(itm),'x',adjustl(num),	&
+    'NET avg        max    imx x% r% i%',	&
+    'SCP avg        max    imx x% r% i%'
+
+!23.|....1....|....2....|....3....|....4....|....5....|....6....|....7..
+
+!MWTIME]x3    NET avg     max imx x% r% i%  SCP avg     max imx x% r% i%
+!-----------------------------------------------------------------------
+!zeit.       333333.3 33333.3 333 33 33 33 333333.3 33333.3 333 33 33 33
+
+write(lu,'(91a)') ('-',i=1,91)
+do l=0,min(MXN,nname)
+
+	! sum() of all processes
+
+  zts_o=0.
+  zts_s=0.
+
+	! indices of max() of all processes
+
+  ix_o=0
+  ix_s=0
+  do k=0,nPE-1
+
+    zts_o=zts_o+ztmp(itm,0,l,k)		! compute sum()
+    zts_s=zts_s+ztmp(itm,1,l,k)		! compute sum()
+
+    if(ztmp(itm,0,l,ix_o) < ztmp(itm,0,l,k)) ix_o=k
+    if(ztmp(itm,1,l,ix_s) < ztmp(itm,1,l,k)) ix_s=k
+      
+  end do
+
+  zta_o=zts_o/max(1,nPE)		! compute mean()
+  zta_s=zts_s/max(1,nPE)		! compute mean()
+
+  ztr_o=0.
+  ztr_s=0.
+  do k=0,nPE-1
+    if(ztmp(itm,0,l,k) > zta_o) ztr_o=ztr_o+ztmp(itm,0,l,k)-zta_o
+    if(ztmp(itm,1,l,k) > zta_s) ztr_s=ztr_s+ztmp(itm,1,l,k)-zta_s
+  end do
+
+  ztm_o=ztmp(itm,0,l,ix_o)
+  ztm_s=ztmp(itm,1,l,ix_s)
+
+  lx=indx(l)
+  name=name_l(lx)
+  ln=max(len_trim(name),lnmax)
+
+  x_o=nint(100.*(ztm_o-zta_o)/max(zts_o,res))
+  r_o=nint(100.* ztr_o       /max(zts_o,res))
+  i_o=nint(100.*(ztm_o-zta_o)/max(ztm_o,res))
+
+  x_s=nint(100.*(ztm_s-zta_s)/max(zts_s,res))
+  r_s=nint(100.* ztr_s       /max(zts_s,res))
+  i_s=nint(100.*(ztm_s-zta_s)/max(ztm_s,res))
+
+  write(lu,'(a,2(3x,f10.6,3x,f10.6,1x,z3.3,3i3,1x))')           &
+	name(1:ln),				&
+	zta_o,ztm_o,ix_o,x_o,r_o,i_o,		&
+	zta_s,ztm_s,ix_s,x_s,r_s,i_s
+
+end do
+write(lu,'(91a)') ('-',i=1,91)
+end subroutine mp_balances_
+
+!=======================================================================
+end module m_zeit
+!.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/Makefile	(revision 4775)
@@ -0,0 +1,133 @@
+SHELL		= /bin/sh
+###############################
+include ../Makefile.conf
+
+VPATH=$(SRCDIR)/mpi-serial
+# SOURCE FILES
+
+MODULE		= mpi-serial
+
+SRCS_F90	= fort.F90
+
+SRCS_C		= mpi.c \
+		  send.c \
+		  recv.c \
+		  collective.c \
+		  req.c \
+		  list.c \
+		  handles.c \
+                  comm.c \
+                  group.c \
+                  time.c \
+                  pack.c
+
+
+OBJS_ALL	= $(SRCS_C:.c=.o) \
+		  $(SRCS_F90:.F90=.o)
+
+
+INCPATH:= $(INCFLAG)$(SRCDIR)/mpi-serial $(INCFLAG). $(INCFLAG)../ $(INCPATH)
+
+#
+# The values used from Makefile.conf
+#
+
+# ALLCFLAGS= -DFORTRAN_UNDERSCORE_
+# ALLCFLAGS= -DFORTRAN_SAME
+# ALLCFLAGS= -DFORTRAN_CAPS
+
+# FC=pgf90
+# AR=ar rv
+# CC=cc
+
+
+###############################
+
+# TARGETS
+
+default: lib$(MODULE).a
+
+examples: ctest ftest
+
+
+MPIFH= mpif.$(FORT_SIZE).h
+
+
+mpif.h: $(MPIFH)
+	cp -f $< $@
+
+fort.o: mpif.h
+
+lib:
+	@if [ ! "$(FORT_SIZE)" ] ; \
+           then echo "Please set FORT_SIZE (e.g. real4double8 or real8double16) when you do the main MCT configure"; \
+                exit 1; fi
+	@if [ ! -r $(MPIFH) ] ; \
+           then echo "Error: there is no $(MPIFH) -" \
+                      "check the value of FORT_SIZE in the main MCT configure" ; \
+                exit 1; fi
+	cp -f $(MPIFH) mpif.h
+	chmod -w mpif.h
+	$(MAKE) $(LIB)
+
+
+
+lib$(MODULE).a: $(OBJS_ALL)
+	echo $(OBJS_ALL)
+	$(RM) $@
+	$(AR) $@ $(OBJS_ALL)
+
+
+LIB	= lib$(MODULE).a
+
+
+###############################
+#RULES
+
+.SUFFIXES:
+.SUFFIXES: .F90 .c .o 
+
+.c.o:
+	$(CC) -c $(INCPATH) $(CFLAGS) $<
+
+.F90.o:
+	$(FC) -c $(INCFLAG). $(INCPATH) $(FPPDEFS) $(FCFLAGS) $(MPEUFLAGS) $<
+
+MYF90FLAGS=$(INCPATH) $(DEFS) $(FCFLAGS)  $(MPEUFLAGS)
+
+clean:
+	/bin/rm -f *.o ctest ftest $(LIB) mpif.h
+
+
+install: lib
+	$(MKINSTALLDIRS) $(libdir) $(includedir)
+	$(INSTALL) lib$(MODULE).a -m 644 $(libdir)
+	$(INSTALL) mpi.h -m 644 $(includedir)
+	$(INSTALL) mpif.h -m 644 $(includedir)
+
+
+
+###############################
+#
+# Create mpif.realXdoubleY.h filesfrom mpif.master.h template
+#
+
+mpif:
+	make-mpif 4 8
+	make-mpif 8 8
+	make-mpif 8 16
+
+
+###############################
+
+#
+# test programs
+#
+
+
+ctest: lib ctest.c
+	$(CC) $(ALLCFLAGS) -o $@ ctest.c -L. -lmpi-serial
+
+ftest: lib ftest.F90
+	$(FC) $(MYF90FLAGS) -o $@ ftest.F90 -L. -lmpi-serial
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/README	(revision 4775)
@@ -0,0 +1,139 @@
+
+######################################################################
+
+mpi-serial
+
+   Ray Loy (rloy@mcs.anl.gov)
+
+######################################################################
+
+
+This library provides a one-processor version of MPI.  Most common MPI
+calls, including all that are necessary for MCT, are supported.  This
+includes sends and receives (which cannot be simply stubbed out).  See
+below for a complete list.
+
+
+---------------
+Configuration
+---------------
+
+During the MCT configure, specify the option:
+
+   --enable-mpiserial
+
+
+This will cause the main MCT 'make' to compile mpi-serial and use it.
+
+IMPORTANT:
+
+By default, it is assumed that Fortran programs linked with mpi-serial
+(e.g. MCT) will be using REAL variables of size 4 bytes, and DOUBLE
+PRECISION variables of size 8 bytes.  If this is not the case
+(e.g. due to hardware sizes or Fortran compiler options), you must
+specify a value for FORT_SIZE, e.g.:
+
+   --enable-mpiserial FORT_SIZE=real8double8
+
+
+The built-in choices for FORT_SIZE are:
+
+   real4double8       (default)
+   real8double8       (use when only REALs are auto-promoted)
+   real8double16      (use when REALs and DOUBLEs are auto-promoted)
+
+
+How to configure for other Fortran data sizes:
+----------------------------------------------
+
+The setting for FORT_SIZE is actually just a name used to choose a
+pre-made mpif.h file, mpif.$(FORT_SIZE).h, whose contents set the
+sizes of Fortran data types.  If you need a different set of sizes,
+you can copy one of these files and edit it to reflect the desired
+sizes.  E.g. Copy mpif.real4double8.h to mpif.mysize.h and edit these
+lines:
+
+        PARAMETER (MPI_REAL=4)                 ! 4 is number of bytes
+        
+        PARAMETER (MPI_DOUBLE_PRECISION=8)     ! 8 is number of bytes
+
+then configure MCT using:
+
+   --enable-mpiserial FORT_SIZE=mysize
+
+
+
+At runtime (within MPI_Init), there is a consistancy check of Fortran
+data type sizes.  If any sizes conflict with the config, there will be
+an error message.
+
+
+Advanced: The sizes of other types can be set in the same manner.
+However, note that the size of a Fortran "INTEGER" must be the same as
+C type specified for MPI_Status_int in mpi.h.  Consult the author for
+further advice.
+
+
+
+--------------------------------
+Manual make targets
+--------------------------------
+
+Note: Normally this is handled by the main MCT 'make'.
+      See "Configuration" above.
+
+
+'make'  - compile the mpi-serial library
+
+'make examples'  - compile mpi-serial and its example programs
+
+'make clean'  - get rid of all objects and executables
+
+
+
+----------------------------------
+List of MPI calls supported
+----------------------------------
+
+    general ops
+      mpi_init
+      mpi_finalize
+      mpi_abort
+      mpi_error_string
+      mpi_initialized
+
+    comm and group ops
+      mpi_comm_free
+      mpi_comm_size
+      mpi_comm_rank
+      mpi_comm_dup
+      mpi_comm_create
+      mpi_comm_split
+      mpi_comm_group
+      mpi_group_incl
+      mpi_group_free
+
+    send/receive ops
+      mpi_irecv
+      mpi_recv
+      mpi_test
+      mpi_wait
+      mpi_waitany
+      mpi_waitall
+      mpi_isend
+      mpi_send
+
+    collective operations
+      mpi_barrier
+      mpi_bcast
+      mpi_gather
+      mpi_gatherv
+      mpi_allgather
+      mpi_scatterv
+      mpi_reduce
+      mpi_allreduce
+
+
+
+-----
+EOF
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/collective.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/collective.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/collective.c	(revision 4775)
@@ -0,0 +1,428 @@
+
+#include "mpiP.h"
+
+
+
+/*
+ * COLLECTIVE
+ */
+
+
+FC_FUNC( mpi_barrier , MPI_BARRIER )(int *comm, int *ierror)
+{
+  *ierror=MPI_Barrier( *comm );
+}
+
+
+int MPI_Barrier(MPI_Comm comm )
+{
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_bcast , MPI_BCAST )(void *buffer, int *count, int *datatype,
+				   int *root, int *comm, int *ierror )
+{
+  *ierror=MPI_Bcast(buffer, *count, *datatype, *root, *comm);
+}
+
+
+
+int MPI_Bcast(void* buffer, int count, MPI_Datatype datatype,
+	      int root, MPI_Comm comm )
+{
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Bcast: bad root = %d\n",root);
+      abort();
+    }
+
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_gather , MPI_GATHER )
+                       (void *sendbuf, int *sendcount, int *sendtype,
+			void *recvbuf, int *recvcount, int *recvtype,
+			int *root, int *comm, int *ierror)
+{
+  *ierror=MPI_Gather( sendbuf, *sendcount, *sendtype,
+		      recvbuf, *recvcount, *recvtype,
+		      *root, *comm);
+}
+
+
+int MPI_Gather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+	       void* recvbuf, int recvcount, MPI_Datatype recvtype,
+	       int root, MPI_Comm comm)
+{
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Gather: bad root = %d\n",root);
+      abort();
+    }
+
+  memcpy(recvbuf,sendbuf,sendcount*sendtype);
+
+  return(MPI_SUCCESS);
+}
+
+/*********/
+
+
+
+FC_FUNC( mpi_gatherv , MPI_GATHERV )
+                        ( void *sendbuf, int *sendcount, int *sendtype,
+			  void *recvbuf, int *recvcounts, int *displs,
+			  int *recvtype, int *root, int *comm, int *ierror)
+{
+  *ierror=MPI_Gatherv( sendbuf, *sendcount, *sendtype,
+		       recvbuf, recvcounts, displs,
+		       *recvtype, *root, *comm);
+}
+
+
+int MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype, 
+		void* recvbuf, int *recvcounts, int *displs,
+		MPI_Datatype recvtype, int root, MPI_Comm comm)
+{
+  int offset;
+
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Gatherv: bad root = %d\n",root);
+      abort();
+    }
+
+  offset=displs[0]*recvtype;
+  memcpy( (char *)recvbuf+offset, sendbuf, recvcounts[0] * recvtype);
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_allgather , MPI_ALLGATHER )
+                          ( void *sendbuf, int *sendcount, int *sendtype,
+			    void *recvbuf, int *recvcount, int *recvtype,
+			    int *comm, int *ierror)
+{
+  *ierror=MPI_Allgather( sendbuf, *sendcount, *sendtype,
+			 recvbuf, *recvcount, *recvtype,
+			 *comm );
+}
+
+
+int MPI_Allgather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+		  void* recvbuf, int recvcount, MPI_Datatype recvtype,
+		  MPI_Comm comm)
+{
+
+  memcpy(recvbuf,sendbuf,sendcount * sendtype);
+
+  return(MPI_SUCCESS);
+
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_allgatherv , MPI_ALLGATHERV )
+                          ( void *sendbuf, int *sendcount, int *sendtype,
+			    void *recvbuf, int *recvcounts, int *displs,
+                            int *recvtype, int *comm, int *ierror)
+{
+  *ierror=MPI_Allgatherv( sendbuf, *sendcount, *sendtype,
+			  recvbuf, recvcounts, displs,
+                          *recvtype, *comm );
+}
+
+
+int MPI_Allgatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+		   void* recvbuf, int *recvcounts, int *displs,
+                   MPI_Datatype recvtype, MPI_Comm comm)
+{
+  int offset;
+
+  offset=displs[0]*recvtype;
+  memcpy( (char *)recvbuf+offset, sendbuf, recvcounts[0] * recvtype);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_scatter , MPI_SCATTER )
+                         ( void *sendbuf, int *sendcount, int *sendtype,
+                           void *recvbuf, int *recvcount, int *recvtype,
+                           int *root, int *comm, int *ierror)
+{
+  *ierror=MPI_Scatter( sendbuf, *sendcount, *sendtype,
+                       recvbuf, *recvcount, *recvtype,
+                       *root, *comm);
+}
+		       
+		       
+
+int MPI_Scatter( void* sendbuf, int sendcount, MPI_Datatype sendtype, 
+                 void* recvbuf, int recvcount, MPI_Datatype recvtype,
+                 int root, MPI_Comm comm)
+{
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Scatter: bad root = %d\n",root);
+      abort();
+    }
+
+  memcpy(recvbuf,sendbuf,sendcount * sendtype);
+  
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_scatterv , MPI_SCATTERV )
+                         ( void *sendbuf, int *sendcounts, int *displs,
+			   int *sendtype, void *recvbuf, int *recvcount,
+			   int *recvtype, int *root, int *comm, int *ierror)
+{
+  *ierror=MPI_Scatterv(sendbuf, sendcounts, displs,
+		       *sendtype, recvbuf, *recvcount,
+		       *recvtype, *root, *comm);
+}
+		       
+		       
+
+int MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs, 
+		 MPI_Datatype sendtype, void* recvbuf, int recvcount, 
+		 MPI_Datatype recvtype, int root, MPI_Comm comm)
+{
+  int offset;
+
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Scatterv: bad root = %d\n",root);
+      abort();
+    }
+
+  offset=displs[0]*sendtype;
+  memcpy(recvbuf,(char *)sendbuf+offset,sendcounts[0] * sendtype);
+  
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_reduce , MPI_REDUCE )
+                       ( void *sendbuf, void *recvbuf, int *count,
+			 int *datatype, int *op, int *root, int *comm,
+			 int *ierror)
+{
+  *ierror=MPI_Reduce(sendbuf, recvbuf, *count,
+		     *datatype, *op, *root, *comm);
+}
+
+
+
+int MPI_Reduce(void* sendbuf, void* recvbuf, int count, 
+	       MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
+
+{
+  if (root==MPI_ROOT)
+    return(MPI_SUCCESS);
+
+  if (root!=0)
+    {
+      fprintf(stderr,"MPI_Reduce: bad root = %d\n",root);
+      abort();
+    }
+
+  memcpy(recvbuf,sendbuf,count * datatype);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_allreduce , MPI_ALLREDUCE )
+                          ( void *sendbuf, void *recvbuf, int *count,
+			    int *datatype, int *op, int *comm, int *ierror)
+{
+  *ierror=MPI_Allreduce(sendbuf, recvbuf, *count,
+			*datatype, *op, *comm);
+
+}
+
+
+int MPI_Allreduce(void* sendbuf, void* recvbuf, int count, 
+		  MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
+{
+
+  memcpy(recvbuf,sendbuf,count * datatype);
+
+  return(MPI_SUCCESS);
+
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_scan , MPI_SCAN )
+                       ( void *sendbuf, void *recvbuf, int *count,
+			 int *datatype, int *op, int *comm,
+			 int *ierror)
+{
+  *ierror=MPI_Scan( sendbuf, recvbuf, *count,
+                    *datatype, *op, *comm);
+}
+
+
+
+int MPI_Scan( void* sendbuf, void* recvbuf, int count, 
+              MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
+
+{
+
+  memcpy(recvbuf,sendbuf,count * datatype);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_alltoall , MPI_ALLTOALL )
+                        ( void *sendbuf, int *sendcount, int *sendtype,
+			  void *recvbuf, int *recvcount, int *recvtype,
+                          int *comm, int *ierror )
+{
+  *ierror=MPI_Alltoall(sendbuf, *sendcount, *sendtype,
+		       recvbuf, *recvcount, *recvtype,
+		       *comm);
+}
+
+
+int MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype sendtype,
+		 void *recvbuf, int recvcount, MPI_Datatype recvtype,
+		 MPI_Comm comm)
+{
+
+  memcpy(recvbuf,sendbuf,sendcount * sendtype);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_alltoallv , MPI_ALLTOALLV )
+           ( void *sendbuf, int *sendcounts, int *sdispls, int *sendtype,
+	     void *recvbuf, int *recvcounts, int *rdispls, int *recvtype,
+             int *comm, int *ierror )
+{
+
+  *ierror=MPI_Alltoallv(sendbuf, sendcounts, sdispls, *sendtype,
+			recvbuf, recvcounts, rdispls, *recvtype,
+			*comm);
+
+}
+
+int MPI_Alltoallv(void *sendbuf, int *sendcounts,
+		  int *sdispls, MPI_Datatype sendtype,
+                  void *recvbuf, int *recvcounts,
+		  int *rdispls, MPI_Datatype recvtype,
+                  MPI_Comm comm) 
+
+{
+  int send_offset;
+  int recv_offset;
+
+  send_offset=sdispls[0]*sendtype;
+  recv_offset=rdispls[0]*recvtype;
+
+
+  memcpy( (char *)recvbuf+recv_offset, (char *)sendbuf+send_offset,
+	  sendcounts[0] * sendtype);
+
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_op_create , MPI_OP_CREATE )
+  ( void *function, int *commute, int *op, int *ierror )
+{
+  *ierror=MPI_Op_create(function,*commute,op);
+}
+
+
+
+int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op)
+{
+  *op=MPI_OP_NULL;
+
+  return(MPI_SUCCESS);
+
+}
+
+
+
+
+/*********/
+
+MPI_Op MPI_Op_f2c(MPI_Fint op)
+{
+  return(op);
+}
+
+
+/*********/
+
+
+MPI_Fint MPI_Op_c2f(MPI_Op op)
+{
+  return(op);
+}
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/comm.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/comm.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/comm.c	(revision 4775)
@@ -0,0 +1,227 @@
+
+#include "mpiP.h"
+
+
+
+/*
+ * Communicators
+ *
+ */
+
+
+
+MPI_Comm mpi_comm_new(void)
+{
+  MPI_Comm chandle;
+  Comm *cptr;
+  static int num=0;
+
+  mpi_alloc_handle(&chandle,(void **) &cptr);
+
+  cptr->sendlist=AP_list_new();
+  cptr->recvlist=AP_list_new();
+
+  cptr->num=num++;
+
+  return(chandle);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_comm_free , MPI_COMM_FREE )(int *comm, int *ierror)
+{
+  *ierror=MPI_Comm_free(comm);
+}
+
+
+/*
+ * MPI_Comm_free()
+ *
+ * Note: will NOT free any pending MPI_Request handles
+ * that are allocated...  correct user code should have
+ * already done a Wait or Test to free them.
+ *
+ */
+
+
+int MPI_Comm_free(MPI_Comm *comm)
+{
+  pList sendlist, recvlist;
+  int size;
+  Comm *mycomm;
+
+  mycomm=mpi_handle_to_ptr(*comm);   /* (Comm *)(*comm) */
+
+  sendlist=mycomm->sendlist;
+  recvlist=mycomm->recvlist;
+
+  size=AP_list_size(sendlist);
+  if (size!=0)
+    fprintf(stderr,"MPI_Comm_free: warning: %d pending send reqs\n",
+	    size);
+  AP_list_free(sendlist);
+
+
+  size=AP_list_size(recvlist);
+  if (size!=0)
+    fprintf(stderr,"MPI_Comm_free: warning: %d pending receive reqs\n",
+	    size);
+  AP_list_free(recvlist);
+
+  mpi_free_handle(*comm);            /* free(mycomm); */
+  *comm=MPI_COMM_NULL;
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_comm_size , MPI_COMM_SIZE )(int *comm, int *size, int *ierror)
+{
+  *ierror=MPI_Comm_size(*comm, size);
+}
+
+
+
+int MPI_Comm_size(MPI_Comm comm, int *size)
+{
+  *size=1;
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_comm_rank , MPI_COMM_RANK )(int *comm, int *rank, int *ierror)
+{
+  *ierror=MPI_Comm_rank( *comm, rank);
+}
+
+
+int MPI_Comm_rank(MPI_Comm comm, int *rank)
+{
+  *rank=0;
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_comm_dup , MPI_COMM_DUP )(int *comm, int *newcomm, int *ierror)
+{
+
+  *ierror=MPI_Comm_dup( *comm, newcomm);
+
+}
+
+
+int MPI_Comm_dup(MPI_Comm comm, MPI_Comm *newcomm)
+{
+  *newcomm= mpi_comm_new();
+
+#ifdef INFO
+  fflush(stdout);
+  fprintf(stderr,"MPI_Comm_dup: new comm handle=%d\n",*newcomm);
+#endif
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+int FC_FUNC( mpi_comm_create, MPI_COMM_CREATE)
+     (int *comm, int *group, int *newcomm, int *ierror)
+{
+  *ierror=MPI_Comm_create(*comm,*group,newcomm);
+}
+
+
+
+int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm)
+{
+  if (group==MPI_GROUP_NULL || group==MPI_GROUP_EMPTY)
+    *newcomm= MPI_COMM_NULL;
+  else
+    *newcomm=mpi_comm_new();
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_comm_split, MPI_COMM_SPLIT )
+     (int *comm, int *color, int *key, int *newcomm, int *ierror)
+{
+  *ierror=MPI_Comm_split(*comm,*color,*key,newcomm);
+
+}
+
+
+
+int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm)
+{
+  if (color==MPI_UNDEFINED)
+    *newcomm=MPI_COMM_NULL;
+  else
+    *newcomm= mpi_comm_new();
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_comm_group, MPI_COMM_GROUP )
+     (int *comm, int *group, int *ierror)
+{
+  *ierror= MPI_Comm_group(*comm, group);
+}
+
+
+
+int MPI_Comm_group(MPI_Comm comm, MPI_Group *group)
+{
+  if (comm==MPI_COMM_NULL)
+    *group= MPI_GROUP_NULL;
+  else
+    *group= MPI_GROUP_ONE;
+
+  return(MPI_SUCCESS);
+}    
+
+
+
+/*********/
+
+
+MPI_Comm MPI_Comm_f2c(MPI_Fint comm)
+{
+  /* Comm is an integer handle used both by C and Fortran */
+  return(comm);
+}
+
+
+MPI_Fint MPI_Comm_c2f(MPI_Comm comm)
+{
+  return(comm);
+}
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ctest.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ctest.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ctest.c	(revision 4775)
@@ -0,0 +1,183 @@
+
+#include <stdio.h>
+#include "mpi.h"
+
+
+
+
+
+main(int argc, char *argv[])
+{
+  MPI_Request sreq[10], sreq2[10], rreq[10], rreq2[10];
+  int sbuf[10],sbuf2[10],rbuf[10],rbuf2[10];
+  int tag;
+  MPI_Status status[10], sr_status;
+  int i,j;
+  MPI_Comm comm2;
+  int flag;
+  MPI_Group mygroup;
+  char pname[MPI_MAX_PROCESSOR_NAME];
+  int pnamelen;
+
+  int position, temp;
+
+
+  printf("Time: %f\n",MPI_Wtime());
+
+  MPI_Initialized(&flag);
+  printf("MPI is initialized = %d\n",flag);
+
+  MPI_Init(NULL,NULL);
+
+  MPI_Get_processor_name(pname,&pnamelen);
+  printf("Processor name: %s (len=%d)\n",pname,pnamelen);
+
+#if 0
+  MPI_Comm_dup(MPI_COMM_WORLD,&comm2);
+#endif
+
+#if 0
+  MPI_Comm_split(MPI_COMM_WORLD,42,99,&comm2);
+#endif
+
+#if 1
+  MPI_Comm_group(MPI_COMM_WORLD,&mygroup);
+  MPI_Comm_create(MPI_COMM_WORLD,mygroup,&comm2);
+#endif
+
+  MPI_Initialized(&flag);
+  printf("MPI is initialized = %d\n",flag);
+
+  for (i=0; i<5; i++)
+    {
+      tag=100+i;
+      printf("COMWORLD Post ireceive tag %d\n",tag);
+
+      MPI_Irecv(&rbuf[2*i],1,MPI_2INT,
+		0,tag,MPI_COMM_WORLD,&rreq[i]);
+    }
+
+  for (i=0; i<5; i++)
+    {
+      sbuf2[i]=1000+10*i;
+      tag=100+i;
+      printf("COM2 Post isend %d tag %d\n",sbuf2[i],tag);
+      MPI_Isend(&sbuf2[i],1,MPI_INT,0,tag,comm2,&sreq2[i]);
+    }
+
+  for (i=0; i<5; i++)
+    {
+      sbuf[2*i]=10*i;
+      sbuf[2*i+1]=10*i+1;
+      tag=100+(4-i);
+      printf("COMWORLD Post irsend %d tag %d\n",sbuf[i],tag);
+      MPI_Irsend(&sbuf[2*i],1,MPI_2INT,0,tag,MPI_COMM_WORLD,&sreq[i]);
+    }
+
+
+  printf("Time: %f\n",MPI_Wtime());
+  MPI_Waitall(5,sreq,status);
+  MPI_Waitall(5,rreq,status);
+
+  printf("Waiting for COMWORLD send/receives\n");
+
+  for (i=0; i<5; i++)
+    printf("tag %d rbuf= %d %d\n",status[i].MPI_TAG,rbuf[2*i],rbuf[2*i+1]);
+
+
+  for (i=0; i<5; i++)
+    {
+      tag=100+i;
+      printf("COM2 Post receive tag %d\n",tag);
+
+      MPI_Irecv(&rbuf2[i],1,MPI_INT,
+		0,tag,comm2,&rreq2[i]);
+    }
+
+
+  MPI_Waitall(5,sreq2,status);
+  MPI_Waitall(5,rreq2,status);
+
+  printf("Waiting for COM2 send/receive\n");
+
+  for (i=0; i<5; i++)
+    printf("tag %d rbuf= %d\n",status[i].MPI_TAG,rbuf2[i]);
+
+
+  /*
+   * pack/unpack
+   */
+
+  position=0;
+  for (i=0; i<5; i++)
+    {
+      temp=100+i;
+      MPI_Pack(&temp, 1, MPI_INT, sbuf, 20, &position, MPI_COMM_WORLD); 
+    }
+
+  MPI_Isend( sbuf, position, MPI_PACKED, 0, 0, MPI_COMM_WORLD,&sreq[0]); 
+
+  MPI_Irecv( rbuf, position, MPI_PACKED, 0, 0, MPI_COMM_WORLD, &rreq[0] );
+  MPI_Waitall(1,rreq,status);
+
+  printf("Pack/send/unpack: \n");
+
+  position=0;
+  for (i=0; i<5; i++)
+    {
+      MPI_Unpack(rbuf,20,&position,&temp,1,MPI_INT,MPI_COMM_WORLD);
+      printf("%d\n",temp);
+    }
+
+
+  /*
+   * sendrecv
+   */
+
+
+  sbuf[0]=42;
+  rbuf[0]=0;
+  sr_status.MPI_SOURCE= -1;
+  sr_status.MPI_TAG= -1;
+
+  MPI_Sendrecv(sbuf,1,MPI_INT,0,127,
+	       rbuf,1,MPI_INT,MPI_ANY_SOURCE,MPI_ANY_TAG,
+	       MPI_COMM_WORLD,&sr_status);
+
+  printf("Done with MPI_Sendrecv, rbuf=%d  source=%d  tag=%d\n",
+	 rbuf[0],sr_status.MPI_SOURCE,sr_status.MPI_TAG);
+
+
+  /*
+   * Send to nowhere
+   */
+
+
+  printf("Send to MPI_PROC_NULL\n"); 
+  MPI_Send(sbuf, 1, MPI_INT, MPI_PROC_NULL, 77, MPI_COMM_WORLD);
+
+
+  printf("Receive from MPI_PROC_NULL\n"); 
+  MPI_Recv(rbuf, 1, MPI_INT, MPI_PROC_NULL, 78, MPI_COMM_WORLD, status);
+  printf("  status: source=%d  tag=%d\n",
+	 status[0].MPI_SOURCE,status[0].MPI_TAG);
+  
+
+
+  /*
+   * Finish up
+   */
+
+
+  MPI_Finalize();
+
+
+  for (i=0; i<5; i++)
+    {
+      printf("Time: %f\n",MPI_Wtime());
+      sleep(1);
+    }
+}
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/fort.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/fort.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/fort.F90	(revision 4775)
@@ -0,0 +1,49 @@
+
+
+	subroutine mpi_init(ierror)
+
+        implicit none
+        include "mpif.h"
+
+	integer fint(2)
+	logical flog(2)
+	real freal(2)
+	double precision fdub(2)
+	complex fcomp(2)
+	integer status(MPI_STATUS_SIZE)
+
+        integer ierror
+
+
+        !!
+        !! Pass values from mpif.h to the C side
+        !! to check for consistency mpi.h and hardware sizes.
+        !!
+
+        call mpi_init_fort( MPI_COMM_WORLD, &
+	                    MPI_ANY_SOURCE, MPI_ANY_TAG, &
+                            MPI_PROC_NULL, MPI_ROOT, &
+                            MPI_COMM_NULL, MPI_REQUEST_NULL, &
+                            MPI_GROUP_NULL, MPI_GROUP_EMPTY, &
+                            MPI_UNDEFINED, &
+                            MPI_MAX_ERROR_STRING, &
+                            MPI_MAX_PROCESSOR_NAME, &
+                            MPI_STATUS_SIZE, &
+                            MPI_SOURCE, MPI_TAG, MPI_ERROR, &
+                            status, status(MPI_SOURCE), &
+                            status(MPI_TAG), status(MPI_ERROR), &
+                            MPI_INTEGER, fint(1), fint(2), &
+                            MPI_LOGICAL, flog(1), flog(2), &
+                            MPI_REAL, freal(1), freal(2), &
+                            MPI_DOUBLE_PRECISION, fdub(1), fdub(2), &
+                            MPI_COMPLEX, fcomp(1), fcomp(2), &
+                            IERROR )
+
+
+        return
+	end
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ftest.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ftest.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/ftest.F90	(revision 4775)
@@ -0,0 +1,152 @@
+
+	program test
+	implicit none
+	include "mpif.h"
+
+	integer ier
+
+	integer sreq(10), sreq2(10), rreq(10), rreq2(10)
+	integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10)
+	integer tag
+	integer status(MPI_STATUS_SIZE,10)
+	integer i
+	integer comm2;
+	logical flag;
+	character pname(MPI_MAX_PROCESSOR_NAME)
+	integer pnamesize
+
+        integer temp,position
+
+	external my_op_func
+	integer myop
+
+
+        print *, 'Time=',mpi_wtime()
+
+	call mpi_initialized(flag,ier)
+	print *, 'MPI is initialized=',flag
+
+	call mpi_init(ier)
+
+	call mpi_get_processor_name(pname,pnamesize,ier)
+	print *, 'proc name: "',pname(1:pnamesize),'"  size:',pnamesize
+
+
+	call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier)
+
+	call mpi_initialized(flag,ier)
+	print *, 'MPI is initialized=',flag
+
+
+
+
+	do i=1,5
+	  tag= 100+i
+	  print *,  'Post receive tag ',tag
+
+	  call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, &
+                          MPI_COMM_WORLD,rreq(i),ier)
+
+	end do
+	do i=1,5
+!	  tag=1100+i
+!	  print *,  'Post receive tag ',tag
+
+	  call mpi_irecv( rbuf2(i),1,MPI_INTEGER, &
+                          MPI_ANY_SOURCE, MPI_ANY_TAG, &
+                          comm2,rreq2(i),ier)
+
+	end do
+
+
+	do i=1,5
+	  sbuf(i)=10*i
+	  tag=100+i
+	  print *, 'Send ',sbuf(i),' tag ',tag
+
+	  call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, &
+	                  MPI_COMM_WORLD,sreq(i),ier)
+	end do
+
+
+	do i=1,5
+	  sbuf2(i)=1000+10*i
+	  tag=1100+i
+	  print *, 'Send ',sbuf2(i),' tag ',tag
+
+	  call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, &
+	                  comm2,sreq2(i),ier)
+	end do
+
+
+        print *, 'Time=',mpi_wtime()
+	call mpi_waitall(5,sreq,status,ier)
+	print *,'sends on MPI_COMM_WORLD done'
+
+	call mpi_waitall(5,rreq,status,ier)
+	print *,'recvs on MPI_COMM_WORLD done'
+	
+	do i=1,5
+          print *, 'Status source=',status(MPI_SOURCE,i), &
+                   '  tag=',status(MPI_TAG,i)
+	end do
+
+	call mpi_waitall(5,sreq2,status,ier)
+	print *,'sends on comm2 done'
+
+	call mpi_waitall(5,rreq2,status,ier)
+	print *,'recvs on comm2 done'
+
+	do i=1,5
+          print *, 'Status source=',status(MPI_SOURCE,i), &
+                   '  tag=',status(MPI_TAG,i)
+	end do
+
+
+! pack/unpack
+
+	position=0
+	do i=1,5
+          temp=100+i
+	  call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier)
+ 	end do
+
+        call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier)
+	call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier)
+        call mpi_waitall(1,rreq,status,ier)
+
+        print *,"Pack/send/unpack:"
+
+        position=0
+	do i=1,5
+	  call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, &
+                           MPI_COMM_WORLD,ier)
+          print *,temp
+        end do
+
+!
+	print *,"Creating op"
+	call mpi_op_create(my_op_func,.TRUE.,myop,ier)
+
+
+	call mpi_finalize(ier)
+
+	do i=1,5
+          print *, 'Time=',mpi_wtime()
+          call sleep(1)
+	end do
+
+ 	end
+
+
+
+
+	function my_op_func(invec,inoutvec,len,type)
+	integer invec(len),inoutvec(len)
+	integer len,type
+
+	return
+	end function my_op_func
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/group.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/group.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/group.c	(revision 4775)
@@ -0,0 +1,257 @@
+
+#include "mpiP.h"
+
+
+/*********/
+
+
+FC_FUNC( mpi_group_incl, MPI_GROUP_INCL )
+     (int *group, int *n, int *ranks, int *newgroup, int *ierror)
+{
+  *ierror= MPI_Group_incl(*group, *n, ranks, newgroup);
+}
+
+
+int MPI_Group_incl(MPI_Group group, int n, int *ranks, MPI_Group *newgroup)
+{
+
+  if (group==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_incl: null group passed in\n");
+      abort();
+    }
+
+  if (group==MPI_GROUP_EMPTY || n==0)
+    *newgroup=MPI_GROUP_EMPTY;
+  else
+    if (n==1 && ranks[0]==0)
+      *newgroup=MPI_GROUP_ONE;
+    else
+      {
+	fprintf(stderr,"MPI_Group_incl: more than 1 proc in group\n");
+	abort();
+      }
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_group_range_incl, MPI_GROUP_RANGE_INCL )
+     (int *group, int *n, int ranges[][3], int *newgroup, int *ierror)
+{
+  *ierror= MPI_Group_range_incl(*group, *n, ranges, newgroup);
+}
+  
+
+int MPI_Group_range_incl(MPI_Group group, int n, int ranges[][3],
+			 MPI_Group *newgroup)
+{
+
+  if (group==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_range_incl: null group passed in\n");
+      abort();
+    }
+
+  if (group==MPI_GROUP_EMPTY || n==0)
+    *newgroup=MPI_GROUP_EMPTY;
+  else
+    if (n==1 && ranges[0][0]==0 && ranges[0][1]==0)
+      *newgroup=MPI_GROUP_ONE;
+    else
+      {
+	fprintf(stderr,"MPI_Group_range_incl: more than 1 proc in group\n");
+	abort();
+      }
+
+  return(MPI_SUCCESS);
+}
+
+
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_group_union, MPI_GROUP_UNION )
+     (int *group1, int *group2, int *newgroup, int *ierror)
+{
+  *ierror= MPI_Group_union(*group1,*group2,newgroup);
+}
+
+
+
+int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup)
+{
+
+  if (group1==MPI_GROUP_NULL || group2==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_union: null group passed in\n");
+      abort();
+    }
+  
+  if (group1==MPI_GROUP_ONE || group2==MPI_GROUP_ONE)
+    *newgroup=MPI_GROUP_ONE;
+  else
+    *newgroup=MPI_GROUP_EMPTY;
+
+
+  return(MPI_SUCCESS);
+}
+
+/*********/
+
+
+
+FC_FUNC( mpi_group_intersection, MPI_GROUP_INTERSECTION )
+     (int *group1, int *group2, int *newgroup, int *ierror)
+{
+  *ierror= MPI_Group_intersection(*group1,*group2,newgroup);
+}
+
+
+
+int MPI_Group_intersection(MPI_Group group1, MPI_Group group2,
+			   MPI_Group *newgroup)
+{
+
+  if (group1==MPI_GROUP_NULL || group2==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_intersection: null group passed in\n");
+      abort();
+    }
+  
+  if (group1==MPI_GROUP_ONE && group2==MPI_GROUP_ONE)
+    *newgroup=MPI_GROUP_ONE;
+  else
+    *newgroup=MPI_GROUP_EMPTY;
+
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_group_difference, MPI_GROUP_DIFFERENCE )
+     (int *group1, int *group2, int *newgroup, int *ierror)
+{
+  *ierror= MPI_Group_difference(*group1,*group2,newgroup);
+}
+
+
+
+int MPI_Group_difference(MPI_Group group1, MPI_Group group2,
+			 MPI_Group *newgroup)
+{
+
+  if (group1==MPI_GROUP_NULL || group2==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_intersection: null group passed in\n");
+      abort();
+    }
+  
+  if (group1==MPI_GROUP_EMPTY || group2==MPI_GROUP_ONE)
+    *newgroup=MPI_GROUP_EMPTY;
+  else
+    *newgroup=MPI_GROUP_ONE;
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+FC_FUNC( mpi_group_free, MPI_GROUP_FREE )(int *group, int *ierror)
+{
+  *ierror= MPI_Group_free(group);
+}
+
+
+int MPI_Group_free(MPI_Group *group)
+{
+  *group= MPI_GROUP_NULL;
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_group_translate_ranks, MPI_GROUP_TRANSLATE_RANKS )
+     ( int *group1, int *n, int *ranks1,
+       int *group2, int *ranks2, int *ierror)
+{
+  *ierror= MPI_Group_translate_ranks(*group1,*n,ranks1,*group2,ranks2);
+}
+
+
+
+int MPI_Group_translate_ranks(MPI_Group group1, int n, int *ranks1,
+			      MPI_Group group2, int *ranks2)
+{
+  int i;
+
+  if (group1==MPI_GROUP_NULL || group2==MPI_GROUP_NULL)
+    {
+      fprintf(stderr,"MPI_Group_translate_ranks: null group passed in\n");
+      abort();
+    }
+
+  if (n==0)
+    return(MPI_SUCCESS);
+
+  if (group1==MPI_GROUP_EMPTY)
+    {
+      fprintf(stderr,"MPI_Group_translate_ranks: empty input group\n");
+      abort();
+    }    
+
+  for (i=0; i<n; i++)
+    {
+      if (ranks1[i]!=0)
+	{
+	  fprintf(stderr,"MPI_Group_translate_ranks: bad input rank: %d\n",
+		  ranks1[i]);
+	  abort();
+	}
+
+      if (group2!=MPI_GROUP_EMPTY)
+	ranks2[i]=ranks1[i];
+      else
+	ranks2[i]=MPI_UNDEFINED;
+    }
+      
+
+  return(MPI_SUCCESS);
+
+}
+
+
+/*********/
+
+
+MPI_Group MPI_Group_f2c(MPI_Fint group)
+{
+  return(group);
+}
+
+
+/*********/
+
+
+MPI_Fint MPI_Group_c2f(MPI_Group group)
+{
+  return(group);
+}
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/handles.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/handles.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/handles.c	(revision 4775)
@@ -0,0 +1,310 @@
+
+/*
+ * 5/20/2005 RML
+ *
+ */
+
+
+#include "mpiP.h"
+
+/*
+ * handles.c
+ *
+ * handle management
+ * based on code from mpich-1.x/ptrcvt.c
+ * --> simplified and store item directly in the struct
+ * rather than as pointer to separately allocated object.
+ * 
+ * CAVEAT:
+ * as in mpich-1, storage will grow as needed and will 
+ * remain at the high water mark since it is likely that
+ * the user code will repeat the use.
+ *
+ */ 
+
+
+typedef struct _Handleitem
+{
+  int handle;
+  struct _Handleitem *next;
+
+  union
+  {
+    void *anything;           /* At least size of void *  */
+    Comm comm;
+    Req req;
+
+  } data;
+
+
+} Handleitem;
+
+
+/*
+ * These must be consistent with each other
+ *
+ */
+
+#define BLOCK_ITEMS          (256)
+#define HANDLE_TO_BLOCK(x)   ( (x) >> 8)
+#define HANDLE_TO_INDEX(x)   ( (x) & 0xff )
+#define HANDLE(block,index)  ( (block << 8) | (index) )
+
+
+/*
+ * The first block of handle items will be statically allocated.
+ * Subsequent ones will be added if necessary.
+ * blocks[0..nblocks-1] are allocated at any given time.
+ *
+ * Increase MAX_BLOCKS if you *really* need more active request
+ * (Although probably something is wrong if you need more than 256k !!!)
+ *
+ */
+
+
+#define MAX_BLOCKS (1024)
+
+static Handleitem block0[BLOCK_ITEMS];     /* array of handleitems */
+static Handleitem *(blocks[MAX_BLOCKS]);   /* array of pointers to blocks */
+static int nblocks;
+
+
+static int need_to_init=1;
+static Handleitem *nextfree;
+
+
+/************************************************************************/
+
+void *mpi_malloc(int size)
+{
+  void *ret;
+
+  ret=malloc(size);
+
+  if (!ret)
+    {
+      fprintf(stderr,"mpi_malloc: failed to allocate %d bytes\n",size);
+      abort();
+    }
+      
+  return(ret);
+}
+
+
+void mpi_free(void *ptr)
+{
+  free(ptr);
+}
+
+
+/************************************************************************/
+
+
+/*
+ * initialize a block s.t. handles are set and
+ * 0 -> 1 -> 2 ... -> (BLOCK_ITEMS-1) -> NULL
+ *
+ */
+
+static Handleitem *init_block(int block, Handleitem *b)
+{
+  int i;
+
+  for (i=0; i<BLOCK_ITEMS-1; i++)
+    {
+      b[i].handle= HANDLE(block,i);
+      b[i].next = &b[i+1];
+    }
+
+  b[BLOCK_ITEMS-1].handle= HANDLE(block,BLOCK_ITEMS-1);
+  b[BLOCK_ITEMS-1].next=0;
+
+  return( &(b[0]) );
+}
+
+
+
+
+static void init_handles(void)
+{
+  int i;
+  Handleitem *new;
+
+  /*
+   * item 0 will not be used  (handle 0 maps to NULL)
+   *
+   */
+
+  new=init_block(0,block0);
+
+  nextfree=new->next;             /* Skip over using item 0 */
+  new->next=NULL;
+
+  /*
+   * initialize the array of blocks
+   *
+   */
+
+  blocks[0]=block0;
+  nblocks=1;
+
+  for (i=1; i<MAX_BLOCKS; i++)
+    blocks[i]=NULL;
+  
+
+  need_to_init=0;
+}
+
+
+
+void mpi_destroy_handles(void)
+{
+  int i;
+
+  if (need_to_init)
+    return;
+
+  for (i=1; i<nblocks; i++)          /* blocks[0] is statically allocated */
+    mpi_free(blocks[i]);
+
+  need_to_init=1;
+}
+
+
+/************************************************************************/
+
+
+void mpi_alloc_handle(int *handle, void **data)
+{
+  Handleitem *new;
+  int i;
+
+  if (need_to_init)
+    init_handles();
+
+  if (nextfree)
+    {
+      new= nextfree;
+      nextfree= nextfree->next;
+      new->next=NULL;
+
+      *handle= new->handle;
+      *data= &(new->data);
+
+      return;
+    }
+
+  /* there is nothing free, so allocate a new block and add it
+   * to blocks[]
+   */
+
+  if (nblocks==MAX_BLOCKS)
+    {
+      fprintf(stderr,"mpi_allocate_handle: max %d active handles exceeded\n",
+	      MAX_BLOCKS*BLOCK_ITEMS);
+      abort();
+    }
+
+  blocks[nblocks]= (Handleitem *)mpi_malloc(sizeof(Handleitem)* BLOCK_ITEMS);
+  new=init_block(nblocks,blocks[nblocks]);
+
+  nextfree= new->next;
+  new->next=NULL;
+
+  *handle= new->handle;
+  *data= &(new->data);
+
+  nblocks++;  /* DON'T FORGET THIS!!!! */
+
+#ifdef HANDLE_INFO
+  fflush(stdout);
+  fprintf(stderr,"mpi_alloc_handle: allocation %d blocks (%d handles)\n",
+	  nblocks,nblocks*BLOCK_ITEMS);
+#endif
+
+}
+
+
+
+
+static void verify_handle(int handle, int block, int index)
+{
+  if (block>=nblocks || block<0 ||
+      index>=BLOCK_ITEMS || index<0)
+    {
+      fprintf(stderr,"mpi_verify_handle: bad handle\n");
+      abort();
+    }
+
+  if (blocks[block][index].handle != handle)
+    {
+      fprintf(stderr,"mpi_verify_handle: handle mismatch\n");
+      abort();
+    }
+}
+
+
+
+void *mpi_handle_to_ptr(int handle)
+{
+  int block;
+  int index;
+
+  if (need_to_init)
+    init_handles();
+
+  if (!handle)     /* Handle 0 -> NULL */
+    return(NULL);
+
+  block=HANDLE_TO_BLOCK(handle);
+  index=HANDLE_TO_INDEX(handle);
+
+#ifdef CHECKS
+  verify_handle(handle,block,index);
+#endif
+
+  return( &(blocks[block][index].data) );
+}
+
+
+
+void mpi_free_handle(int handle)
+{
+  int block;
+  int index;
+  Handleitem *item;
+
+  if (!handle)                         /* ignore null handle */
+    return;
+
+  if (need_to_init)
+    {
+      fprintf(stderr,"mpi_free_handle: handles not initialized\n");
+      abort();
+    }
+
+  block=HANDLE_TO_BLOCK(handle);
+  index=HANDLE_TO_INDEX(handle);
+
+#ifdef CHECKS
+  verify_handle(handle,block,index);
+#endif
+  
+  item=&(blocks[block][index]);
+
+#ifdef CHECKS
+  if (item->next)
+    {
+      fprintf(stderr,"mpi_free_handle: handle still in use\n");
+      abort();
+    }
+#endif
+
+
+  /* just return it to the free list.
+   * space is not reclaimed.
+   */
+
+  item->next=nextfree;
+  nextfree=item;
+}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.c	(revision 4775)
@@ -0,0 +1,710 @@
+/*
+ *  (C) 2000 UNIVERSITY OF CHICAGO
+ *      See COPYRIGHT in top-level directory.
+ */
+
+
+
+#ifdef SYSDARWIN
+ #include <sys/malloc.h>
+#else
+ #include <malloc.h>
+#endif
+#include <stdlib.h>
+#include <stdio.h>
+#include "listops.h"
+#include "listP.h"
+ 
+/*
+ * list management code
+ *
+ * For storing singly-linked lists of pointers.
+ *
+ */
+
+
+static int itemcount=0;
+static int headcount=0;
+
+
+/*
+ * AP_listitem_malloc()
+ *
+ * malloc a new ilist item and return a pointer to it.
+ *
+ */
+
+static pListitem AP_listitem_malloc(void)
+{
+  pListitem item;
+
+  itemcount++;
+  item=(pListitem)malloc( (unsigned) sizeof(Listitem) );
+
+  if (!item)
+    {
+      perror("AP_listitem_malloc: malloc failure");
+      abort();
+    }
+  
+  return(item);
+}
+
+
+
+/*
+ * AP_listitem_free(listitem)
+ *
+ * Free a listitem generated by AP_listitem_malloc()
+ *
+ */
+
+static void AP_listitem_free(pListitem listitem)
+{
+  free(listitem);
+  itemcount--;
+}
+
+
+
+/*
+ * AP_listitem_verify(void)
+ *
+ * Checks to see if there are any outstanding listitems that have been
+ * malloc'd.  Returns true if there are any.
+ *
+ */
+
+int AP_listitem_verify(void)
+{
+  if (itemcount!=0)
+    fprintf(stderr,"AP_list_verify: outstanding items, count=%d\n",
+	    itemcount);
+
+  if (headcount!=0)
+    fprintf(stderr,"AP_list_verify: outstanding lists, count=%d\n",
+	    headcount);
+
+  return( (itemcount!=0) || (headcount!=0) );
+}
+
+
+
+
+pListitem AP_listitem_prev(pListitem listitem)
+{
+  return(listitem->prev);
+}
+  
+
+
+pListitem AP_listitem_next(pListitem listitem)
+{
+  return(listitem->next);
+}
+
+
+
+
+void *AP_listitem_data(pListitem listitem)
+{
+  return(listitem->data );
+}
+
+
+
+
+/***************************************************************/
+
+
+
+/*
+ * AP_list_new(void)
+ * 
+ * allocate an empty list return a pointer to it
+ *
+ */
+
+pList AP_list_new(void)
+{
+  pList list;
+
+  list=(pList)malloc(sizeof(List));
+
+  if (!list)
+    {
+      perror("AP_list_new: malloc failure\n");
+      abort();
+    }
+
+  list->head=NULL;
+  list->tail=NULL;
+  list->count=0;
+
+  headcount++;
+  return(list);
+}
+
+
+
+
+
+/*
+ * AP_list_free(list)
+ *
+ * Free an entire list
+ *
+ */
+
+void AP_list_free(pList list)
+{
+  pListitem next,cur;
+  int count;
+
+  count=0;
+  cur=list->head;
+
+  while(cur)
+    {
+      next=cur->next;
+
+      AP_listitem_free(cur);
+      count++;
+
+      cur=next;
+    }
+
+  if (count!=list->count)
+    {
+      fprintf(stderr,"AP_list_free: count %d does not match actual length %d\n",
+	      list->count,count);
+      abort();
+    }
+  
+  headcount--;
+  free(list);
+}
+
+
+
+/*
+ * AP_list_size(list)
+ *
+ * return the number of items in an ilist
+ * 
+ */
+
+int AP_list_size(pList list)
+{
+  return(list->count);
+}
+
+
+
+/*
+ * AP_list_prepend(list,data)
+ *
+ * Prepend item to the front of list.
+ *
+ */
+
+pListitem AP_list_prepend(pList list, void *data)
+{
+  pListitem new;
+
+  new=AP_listitem_malloc();
+
+  new->data=data;
+  new->prev=NULL;
+  new->next=list->head;
+
+#ifdef CHECKS
+  new->list=list;
+#endif
+
+  if (list->head)
+    list->head->prev=new;
+
+  list->head=new;
+  if (!list->tail)
+    list->tail=new;
+
+  (list->count)++;
+
+  return(new);
+}
+
+
+
+/*
+ * AP_list_append(list,data)
+ *
+ * append item to end of list
+ *
+ */
+
+pListitem AP_list_append(pList list, void *data)
+{
+  pListitem new;
+
+  new=AP_listitem_malloc();
+  new->data=data;
+  new->prev=list->tail;
+  new->next= NULL;
+
+#ifdef CHECKS
+  new->list= list;
+#endif
+
+  if (list->tail)
+    list->tail->next=new;
+  else
+    list->head=new;
+
+  list->tail=new;
+  (list->count)++;
+  
+  return(new);
+}
+
+
+
+
+
+/*
+ * AP_list_delete(list,data)
+ *
+ * delete item from list; return TRUE if successful
+ *
+ */
+
+int AP_list_delete(pList list, void *data)
+{
+  pListitem item;
+
+  if (item=AP_list_search(list,data))
+    {
+      AP_list_delete_item(list,item);
+      return(1);
+    }
+
+  return(0);
+}
+
+
+
+void AP_list_delete_item(pList list, pListitem item)
+{
+
+#ifdef CHECKS
+  if (item->list != list)
+    {
+      fprintf(stderr,"AP_list_delete_item: item is not in list\n");
+      abort();
+    }
+#endif
+
+  /* set pointer of prior listitem */
+
+  if (item == list->head)
+    list->head = item->next;
+  else
+    item->prev->next = item->next;
+
+  /* set pointer of following listitem */
+	  
+  if (item == list->tail)
+    list->tail = item->prev;
+  else
+    item->next->prev = item->prev;
+
+  AP_listitem_free(item);
+  (list->count)--;
+}  
+
+
+
+
+pListitem AP_list_head_item(pList list)
+{
+  return(list->head);
+}
+
+
+
+int AP_list_head(pList list, void **data)
+{
+  if (list->head)
+    {
+      *data=list->head->data;
+      return(1);
+    }
+  else
+    return(0);
+}
+
+
+
+int AP_list_tail(pList list, void **data)
+{
+  if (list->tail)
+    {
+      *data=list->tail->data;
+      return(1);
+    }
+  else
+    return(0);
+}
+
+
+     
+
+
+/*
+ * AP_list_print(str,list)
+ *
+ * Print out the message string followed by the
+ * items in the list
+ *
+ */
+
+void AP_list_print(char *str, pList list)
+{
+  pListitem cur;
+
+  printf("%s (%d items): ",str,list->count);
+
+  cur=list->head;
+  while(cur)
+    {
+      printf("%d ",(int)cur->data);
+      cur=cur->next;
+    }
+
+  printf("\n");
+}
+
+
+
+
+/*
+ * AP_list_revprint(str,list)
+ *
+ * Print out the message string followed by the
+ * items in the list
+ *
+ */
+
+void AP_list_revprint(char *str, pList list)
+{
+  pListitem cur;
+
+  printf("%s (%d items): ",str,list->count);
+
+  cur=list->tail;
+  while(cur)
+    {
+      printf("%d ",(int)cur->data);
+      cur=cur->prev;
+    }
+
+  printf("\n");
+}
+
+
+
+
+/*
+ * AP_list_search(list,data)
+ *
+ * Returns listitem if item appears in the list, otherwise NULL.
+ *
+ */
+
+
+pListitem AP_list_search(pList list, void *data)
+{
+  pListitem cur;
+
+  cur=list->head;
+
+  while (cur)
+    {
+      if (cur->data == data)
+        return(cur);
+
+      cur=cur->next;
+    }
+
+  return(NULL);
+}
+
+
+/*
+ * AP_list_search_func(list,func,data)
+ *
+ * Returns listitem if func(listitem->data,data) returns true
+ *
+ */
+
+
+pListitem AP_list_search_func(pList list,
+			      int (*func)(void *item_data, void *fixed_data),
+			      void *fixed_data)
+{
+  pListitem cur;
+
+  cur=list->head;
+
+  while (cur)
+    {
+      if ( (*func)(cur->data,fixed_data) )
+        return(cur);
+
+      cur=cur->next;
+    }
+
+  return(NULL);
+}
+
+
+
+/*
+ * AP_list_next(list,data,temp)
+ *
+ * like PList_next() except handles NULL pointers properly.
+ *
+ * initially, pass in (void **) NULL in 'temp'
+ * returns next list item through 'item'
+ * returns nonzero if there is a next item
+ *
+ */
+
+int AP_list_next(pList list, void **data, void **temp)
+{
+  pListitem cur;
+
+  if (*temp)                             /* temp is previous item */
+    {
+      cur=(pListitem)(*temp);
+      cur=cur->next;
+    }
+  else                                  /* First item */
+    cur=list->head;
+  
+  if (cur)
+    {
+      *temp=(void *)cur;
+      *data=cur->data;
+      return(1);
+    }
+  else
+    return(0);
+}
+
+
+/*
+ * Compatibility routine for scorec list traversal
+ * Does not provide any way to differentiate
+ * between NULL in the list, and the end of the list
+ *
+ */
+ 
+void *AP_list_braindead_next(pList list, void **temp)
+{
+  void *item;
+
+  if (AP_list_next(list,&item,temp))
+    return(item);
+  else
+    return(NULL);
+}
+
+
+
+/*
+ * AP_list_duplicate(list)
+ *
+ * return a copy of the list
+ * (Note: caller is responsible for freeing this list)
+ *
+ */
+
+pList AP_list_duplicate(pList list)
+{
+  pList newlist;
+  pListitem cur,new,prev;
+
+  newlist=AP_list_new();
+  prev=NULL;
+
+  cur=list->head;
+  while(cur)
+    {
+      new=AP_listitem_malloc();
+      new->data=cur->data;
+      new->prev=prev;
+
+      if (prev)
+	prev->next=new;
+      else
+	newlist->head=new;
+
+      prev=new;
+
+      cur=cur->next;
+    }
+
+  if (prev)
+    prev->next=NULL;
+  
+  newlist->tail=prev;
+  newlist->count=list->count;
+  return(newlist);
+}  
+
+
+
+int AP_list_apply(pList list,
+		  int (*func)(void *item_data, void *fixed_data),
+		  void *fixed_data)
+{
+  pListitem cur;
+  int total;
+
+  total=0;
+  cur=list->head;
+
+  while (cur)
+    {
+      total += (*func)(cur->data,fixed_data);
+
+      cur=cur->next;
+    }
+
+  return(total);
+}
+
+
+
+
+/*
+ * main for debugging
+ *
+ */
+
+
+#ifdef LISTMAIN
+
+int main()
+{
+  pList mylist, list2;
+  int i;
+  void *temp,*item;
+  pListitem next;
+
+  mylist=AP_list_new();
+
+  for (i=1; i<10; i++)
+    {
+      AP_list_prepend(mylist,(void *)i);
+      AP_list_print("current",mylist);
+      AP_list_revprint("    rev",mylist);
+    }
+
+  printf("Size %d\n",AP_list_size(mylist));
+
+  for (i=10; i<15; i++)
+    {
+      AP_list_append(mylist,(void *)i);
+      AP_list_print("new",mylist);
+      AP_list_revprint("    rev",mylist);
+    }
+
+  AP_list_delete(mylist,(void *)5);
+  AP_list_print("less 5",mylist);
+  AP_list_revprint("  rev",mylist);
+
+  AP_list_delete(mylist,(void *)9);
+  AP_list_print("less 9",mylist);
+  AP_list_revprint("  rev",mylist);
+
+  AP_list_delete(mylist,(void *)14);
+  AP_list_print("less 14",mylist);
+  AP_list_revprint("  rev",mylist);
+
+  AP_list_delete(mylist,(void *)2);
+  AP_list_print("less 2",mylist);
+  AP_list_revprint("  rev",mylist);
+
+  if (!AP_list_delete(mylist,(void *)0))
+    printf("(did not delete 0)\n");
+  else
+    printf("ERROR - found 0\n");
+  AP_list_print("less 0",mylist);
+  AP_list_revprint("  rev",mylist);
+
+  if (AP_list_search(mylist,(void *)4))
+    printf("Found 4\n");
+  else
+    printf("Did not find 4\n");
+
+  if (AP_list_search(mylist,(void *)9))
+    printf("Found 9\n");
+  else
+    printf("Did not find 9\n");
+
+  printf("Traversal by AP_list_next()\n");
+  temp=NULL;
+  while (AP_list_next(mylist,&item,&temp))
+    printf("  Got item %d\n",(int)item);
+
+  printf("Traversal by AP_listitem_next()\n");
+  for (item=AP_list_head_item(mylist); item; item=AP_listitem_next(item))
+    printf("  Got item %d\n",(int)(AP_listitem_data(item)));
+
+
+  list2=AP_list_duplicate(mylist);
+  AP_list_print("Original list",mylist);
+  AP_list_revprint("  rev",mylist);
+  AP_list_print("Duplicate    ",list2);
+  AP_list_revprint("  rev",list2);
+
+  AP_list_append(list2,(void *)99);
+  AP_list_print("Dup add 99   ",list2);
+  AP_list_revprint("  rev",list2);
+
+
+  printf("Traversal by AP_listitem_next(), deleting\n");
+  i=0;
+  for (item=AP_list_head_item(list2); item; )
+    {
+      printf("  Got item %d",(int)(AP_listitem_data(item)));
+
+      next=AP_listitem_next(item);
+      
+      if (i%2)
+	{
+	  AP_list_delete_item(list2,item);
+	  printf(" - deleted\n");
+	}
+      else
+	printf("\n");
+
+      item=next;
+      i++;
+    }
+
+  AP_list_print("After delete-traversal",list2);
+
+  AP_list_free(mylist);
+  AP_list_print("After del    ",list2);
+  AP_list_revprint("  rev",list2);
+
+  AP_list_free(list2);
+
+  AP_listitem_verify();
+
+  return(0);
+}
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/list.h	(revision 4775)
@@ -0,0 +1,45 @@
+/*
+ *  (C) 2000 UNIVERSITY OF CHICAGO
+ *      See COPYRIGHT in top-level directory.
+ */
+
+
+
+
+
+/******************************************************  
+ * WARNING: This file automatically generated.        *  
+ *          Do not edit by hand.                      *  
+ ******************************************************  
+ */                                                      
+
+
+
+
+extern int AP_listitem_verify(void);
+extern pListitem AP_listitem_prev(pListitem listitem);
+extern pListitem AP_listitem_next(pListitem listitem);
+extern void *AP_listitem_data(pListitem listitem);
+extern pList AP_list_new(void);
+extern void AP_list_free(pList list);
+extern int AP_list_size(pList list);
+extern pListitem AP_list_prepend(pList list, void *data);
+extern pListitem AP_list_append(pList list, void *data);
+extern int AP_list_delete(pList list, void *data);
+extern void AP_list_delete_item(pList list, pListitem item);
+extern pListitem AP_list_head_item(pList list);
+extern int AP_list_head(pList list, void **data);
+extern int AP_list_tail(pList list, void **data);
+extern void AP_list_print(char *str, pList list);
+extern void AP_list_revprint(char *str, pList list);
+extern pListitem AP_list_search(pList list, void *data);
+extern int AP_list_next(pList list, void **data, void **temp);
+extern void *AP_list_braindead_next(pList list, void **temp);
+extern pList AP_list_duplicate(pList list);
+
+
+extern pListitem AP_list_search_func(pList list, int (*func)(void *i, void *j),void *data);
+
+extern int AP_list_apply(pList list, int (*func)(void *item_data, void *fixed_data), void *data);
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listP.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listP.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listP.h	(revision 4775)
@@ -0,0 +1,33 @@
+/*
+ *  (C) 2000 UNIVERSITY OF CHICAGO
+ *      See COPYRIGHT in top-level directory.
+ */
+
+
+
+/*
+ * Private data structures for the list 
+ *
+ */
+
+
+typedef struct _List
+{
+  pListitem head;
+  pListitem tail;
+  int count;
+} List;
+
+
+typedef struct _Listitem
+{
+  void *data;
+  pListitem prev;
+  pListitem next;
+
+#ifdef CHECKS
+  pList list;
+#endif
+
+} Listitem;
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listops.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listops.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/listops.h	(revision 4775)
@@ -0,0 +1,23 @@
+/*
+ *  (C) 2000 UNIVERSITY OF CHICAGO
+ *      See COPYRIGHT in top-level directory.
+ */
+
+
+
+
+#ifndef _listops_h
+#define _listops_h
+
+/*
+ * Support for singly-linked list of pointers (or ints)
+ *
+ */
+
+
+typedef struct _List     *pList;
+typedef struct _Listitem *pListitem;
+  
+#include "list.h"
+
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/make-mpif
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/make-mpif	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/make-mpif	(revision 4775)
@@ -0,0 +1,25 @@
+#!/bin/bash
+
+# usage: make-mpif <fort_real_size> <fort_double_size>
+#   e.g. make-mpif 4 8
+#
+# from the template in mpif.master.h, creates mpif.realXdoubleY.h file
+#
+
+set -e
+
+if [ $# -ne 2 ]
+  then echo 'Usage: make-mpif <fort_real_size> <fort_double_size>'
+       exit 1
+fi
+
+RSIZE=$1
+DSIZE=$2
+
+DEST=mpif.real${RSIZE}double${DSIZE}.h
+/bin/rm -f $DEST
+
+sed -e s/_RSIZE_/$RSIZE/ -e s/_DSIZE_/$DSIZE/ <mpif.master.h >$DEST
+chmod -w $DEST
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.c	(revision 4775)
@@ -0,0 +1,284 @@
+
+
+#include "mpiP.h"
+
+
+/****************************************************************************/
+
+static int initialized=0;
+
+
+/****************************************************************************/
+
+
+/*
+ * INIT/FINALIZE
+ *
+ */
+
+
+
+FC_FUNC( mpi_init_fort , MPI_INIT_FORT)
+                          (int *f_MPI_COMM_WORLD,
+                           int *f_MPI_ANY_SOURCE, int *f_MPI_ANY_TAG,
+			   int *f_MPI_PROC_NULL, int *f_MPI_ROOT,
+                           int *f_MPI_COMM_NULL, int *f_MPI_REQUEST_NULL,
+			   int *f_MPI_GROUP_NULL, int *f_MPI_GROUP_EMPTY,
+			   int *f_MPI_UNDEFINED,
+                           int *f_MPI_MAX_ERROR_STRING, 
+                           int *f_MPI_MAX_PROCESSOR_NAME, 
+                           int *f_MPI_STATUS_SIZE, 
+                           int *f_MPI_SOURCE, int *f_MPI_TAG, int *f_MPI_ERROR,
+			   int *f_status,
+			   int *fsource, int *ftag, int *ferror,
+                           int *f_MPI_INTEGER, void *fint1, void *fint2,
+                           int *f_MPI_LOGICAL, void *flog1, void *flog2,
+                           int *f_MPI_REAL, void *freal1, void *freal2,
+                           int *f_MPI_DOUBLE_PRECISION,
+			   void *fdub1, void *fdub2,
+			   int *f_MPI_COMPLEX, void *fcomp1, void *fcomp2,
+                           int *ierror)
+{
+  int err;
+  int size;
+  int offset;
+
+  *ierror=MPI_Init(NULL,NULL);
+
+  err=0;
+
+  /*
+   * These 3 macros compare things from mpif.h (as passed in by the f_
+   * arguments) to the values in C (from #including mpi.h).
+   *
+   * Unfortunately, this kind of thing is done most easily in a nasty
+   * looking macto.
+   *
+   */
+
+
+  /*
+   * verify_eq
+   *   compare value of constants in C and fortran
+   *   i.e. compare *f_<name> to <name>
+   */
+
+#define verify_eq(name)  \
+  if (*f_##name != name) \
+    { fprintf(stderr,"mpi-serial: mpi_init_fort: %s not consistant " \
+                     "between mpif.h (%d) and mpi.h (%d)\n",\
+                     #name,*f_##name,name); \
+      err=1; }
+
+#define verify_eq_warn(name)  \
+  if (*f_##name != name) \
+    { fprintf(stderr,"mpi-serial: mpi_init_fort: warning: %s not consistant " \
+                     "between mpif.h (%d) and mpi.h (%d)\n",\
+                     #name,*f_##name,name); \
+    }
+
+
+  /*
+   * verify_size
+   *   verify that the type name in fortran has the correct
+   *   value (i.e. the size of that data type).
+   *   Determine size by subtracting the pointer values of two
+   *   consecutive array locations.
+   */
+
+#define verify_size(name,p1,p2) \
+  if ( (size=((char *)(p2) - (char *)(p1))) != *f_##name ) \
+    { fprintf(stderr,"mpi-serial: mpi_init_fort: mpif.h %s (%d) " \
+                     "does not match actual fortran size (%d)\n", \
+                     #name,*f_##name,size); \
+      err=1; }
+
+  /*
+   * verify_field
+   *   check the struct member offsets for MPI_Status vs. the
+   *   fortan integer array offsets.  E.g. the location of
+   *   status->MPI_SOURCE should be the same as STATUS(MPI_SOURCE)
+   */
+
+#define verify_field(name) \
+  { offset= (char *)&((MPI_Status *)f_status)->name - (char *)f_status; \
+    if ( offset != (*f_##name-1)*sizeof(int) ) \
+    { fprintf(stderr,"mpi-serial: mpi_init_fort: mpif.h %s (%d) (%d bytes) " \
+                     "is inconsistant w/offset in MPI_Status (%d bytes)\n", \
+                    #name,*f_##name,(*f_##name-1)*sizeof(int),offset); \
+      err=1; }}
+
+
+
+  verify_eq(MPI_COMM_WORLD);
+  verify_eq(MPI_ANY_SOURCE);
+  verify_eq(MPI_ANY_TAG);
+  verify_eq(MPI_PROC_NULL);
+  verify_eq(MPI_ROOT);
+  verify_eq(MPI_COMM_NULL);
+  verify_eq(MPI_REQUEST_NULL);
+  verify_eq(MPI_GROUP_NULL);
+  verify_eq(MPI_GROUP_EMPTY);
+  verify_eq(MPI_UNDEFINED);
+  verify_eq(MPI_MAX_ERROR_STRING);
+  verify_eq(MPI_MAX_PROCESSOR_NAME);
+
+  verify_eq(MPI_STATUS_SIZE);
+  verify_field(MPI_SOURCE);
+  verify_field(MPI_TAG);
+  verify_field(MPI_ERROR);
+
+  verify_eq(MPI_INTEGER);
+  verify_size(MPI_INTEGER,fint1,fint2);
+
+  verify_size(MPI_LOGICAL,flog1,flog2);
+
+  verify_eq_warn(MPI_REAL);
+  verify_size(MPI_REAL,freal1,freal2);
+
+  verify_eq(MPI_DOUBLE_PRECISION);
+  verify_size(MPI_DOUBLE_PRECISION,fdub1,fdub2);
+
+  verify_size(MPI_COMPLEX,fcomp1,fcomp2);
+
+  if (err)
+    abort();
+}
+
+
+
+int MPI_Init(int *argc, char **argv[]) 
+{
+  MPI_Comm my_comm_world;
+
+  if (sizeof(MPI_Aint) < sizeof(void *))
+    {
+      fprintf(stderr, "mpi-serial: MPI_Init: "
+                      "MPI_Aint is not large enough for void *\n");
+      abort();
+    }
+
+  my_comm_world=mpi_comm_new();
+
+  if (my_comm_world != MPI_COMM_WORLD)
+    {
+      fprintf(stderr,"MPI_Init: conflicting MPI_COMM_WORLD\n");
+      abort();
+    }
+
+  initialized=1;
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_finalize, MPI_FINALIZE )(int *ierror)
+{
+  *ierror=MPI_Finalize();
+}
+
+
+/*
+ * MPI_Finalize()
+ *
+ * this library doesn't support re-initializing MPI, so
+ * the finalize will just leave everythign as it is...
+ *
+ */
+
+
+int MPI_Finalize(void)
+{
+  initialized=0;
+
+  mpi_destroy_handles();
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_abort , MPI_ABORT )(int *comm, int *errorcode, int *ierror)
+{
+  *ierror=MPI_Abort( *comm, *errorcode);
+}
+
+
+
+int MPI_Abort(MPI_Comm comm, int errorcode)
+{
+  fprintf(stderr,"MPI_Abort: error code = %d\n",errorcode);
+  exit(errorcode);
+}
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_error_string , MPI_ERROR_STRING)
+                             (int *errorcode, char *string,
+			      int *resultlen, int *ierror)
+{
+  *ierror=MPI_Error_string(*errorcode, string, resultlen);
+}
+
+
+int MPI_Error_string(int errorcode, char *string, int *resultlen)
+{
+  sprintf(string,"MPI Error: code %d\n",errorcode);
+  *resultlen=strlen(string);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_get_processor_name , MPI_GET_PROCESSOR_NAME )
+                          (char *name, int *resultlen, int *ierror)
+{
+  *ierror=MPI_Get_processor_name(name,resultlen);
+}
+
+
+int MPI_Get_processor_name(char *name, int *resultlen)
+{
+  int ret;
+
+  ret=gethostname(name,MPI_MAX_PROCESSOR_NAME);
+
+  if (ret!=0)
+    strncpy(name,"unknown host name",MPI_MAX_PROCESSOR_NAME);
+
+
+  name[MPI_MAX_PROCESSOR_NAME-1]='\0';  /* make sure NULL terminated */
+  *resultlen=strlen(name);
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_initialized , MPI_INITIALIZED )(int *flag, int *ierror)
+{
+  *ierror=MPI_Initialized(flag);
+}
+
+
+int MPI_Initialized(int *flag)
+{
+  *flag= initialized;
+
+  return(MPI_SUCCESS);
+}
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpi.h	(revision 4775)
@@ -0,0 +1,308 @@
+
+#ifndef _MPI_H_
+#define _MPI_H_
+
+
+typedef int MPI_Comm;
+typedef int MPI_Request;
+
+
+#define MPI_COMM_WORLD (1)
+#define MPI_COMM_NULL (0)      /* handle 0 maps to NULL */
+
+
+typedef int MPI_Group;
+
+/* MPI_GROUP_EMPTY and MPI_GROUP_NULL must not conflict with MPI_GROUP_ONE */
+#define MPI_GROUP_EMPTY (-1)  
+#define MPI_GROUP_NULL  (0)
+
+
+/*
+ * Return codes
+ *   On error, mpi-serial aborts so the values don't really matter
+ *   as long as they are different than MPI_SUCCESS
+ *
+ */
+
+#define MPI_SUCCESS        (0)
+#define MPI_ERR_BUFFER     (-1)
+#define MPI_ERR_COUNT      (-1)
+#define MPI_ERR_TYPE       (-1)
+#define MPI_ERR_TAG        (-1)
+#define MPI_ERR_COMM       (-1)
+#define MPI_ERR_RANK       (-1)
+#define MPI_ERR_REQUEST    (-1)
+#define MPI_ERR_ROOT       (-1)
+#define MPI_ERR_GROUP      (-1)
+#define MPI_ERR_OP         (-1)
+#define MPI_ERR_TOPOLOGY   (-1)
+#define MPI_ERR_DIMS       (-1)
+#define MPI_ERR_ARG        (-1)
+#define MPI_ERR_UNKNOWN    (-1)
+#define MPI_ERR_TRUNCATE   (-1)
+#define MPI_ERR_OTHER      (-1)
+#define MPI_ERR_INTERN     (-1)
+#define MPI_PENDING        (-1)
+#define MPI_ERR_IN_STATUS  (-1)
+#define MPI_ERR_LASTCODE   (-1)
+
+
+/*
+ * MPI_UNDEFINED
+ *
+ * Uses:
+ *   value for "color" in e.g. comm_split
+ *   value for rank in Group_translate_ranks
+ *
+ */
+
+
+#define MPI_UNDEFINED (-1)
+
+
+/*
+ * Data types etc.
+ */
+
+typedef unsigned long int MPI_Aint;
+#define MPI_BOTTOM (0)
+typedef int MPI_Datatype;
+
+
+/* The type's value is its size in bytes */
+
+#define MPI_DATATYPE_NULL  (0)
+#define MPI_BYTE           (sizeof(char))
+#define MPI_CHAR           (sizeof(char))
+#define MPI_UNSIGNED_CHAR  (sizeof(unsigned char))
+#define MPI_SHORT          (sizeof(short))
+#define MPI_UNSIGNED_SHORT (sizeof(unsigned short))
+#define MPI_INT            (sizeof(int))
+#define MPI_UNSIGNED       (sizeof(unsigned))
+#define MPI_LONG           (sizeof(long))
+#define MPI_UNSIGNED_LONG  (sizeof(unsigned long))
+#define MPI_FLOAT          (sizeof(float))
+#define MPI_DOUBLE         (sizeof(double))
+#define MPI_LONG_DOUBLE    (sizeof(long double))
+#define MPI_PACKED         (sizeof(char))
+
+/* types for MINLOC and MAXLOC */
+
+#define MPI_FLOAT_INT        (sizeof(struct{float a; int b;}))
+#define MPI_DOUBLE_INT       (sizeof(struct{double a; int b;}))
+#define MPI_LONG_INT         (sizeof(struct{long a; int b;}))
+#define MPI_2INT             (sizeof(struct{int a; int b;}))
+#define MPI_SHORT_INT        (sizeof (struct{short a; int b;}))
+#define MPI_LONG_DOUBLE_INT  (sizeof (struct{long double a; int b;}))
+
+/* size-specific types */
+
+#define MPI_INTEGER1       (1)
+#define MPI_INTEGER2       (2)
+#define MPI_INTEGER4       (4)
+#define MPI_INTEGER8       (8)
+#define MPI_INTEGER16      (16)
+
+#define MPI_REAL4          (4)
+#define MPI_REAL8          (8)
+#define MPI_REAL16         (16)
+
+
+
+/*
+ * Fortran int size
+ *
+ */
+
+typedef int MPI_Fint;
+
+
+
+#define MPI_ANY_TAG (-1)
+
+#define MPI_ANY_SOURCE (-1)
+#define MPI_PROC_NULL (-2)
+#define MPI_ROOT (-3)
+
+#define MPI_REQUEST_NULL (0)
+
+#define MPI_MAX_ERROR_STRING (128)
+#define MPI_MAX_PROCESSOR_NAME (128)
+
+
+/*
+ * MPI_Status
+ *
+ * definition must be compatible with the mpif.h values for
+ * MPI_STATUS_SIZE, MPI_SOURCE, MPI_TAG, and MPI_ERROR.
+ *
+ * Note: The type used for MPI_Status_int must be chosen to match
+ * Fortran INTEGER.
+ *
+ */
+
+typedef int MPI_Status_int;
+
+typedef struct                  /* Fortran: INTEGER status(MPI_STATUS_SIZE) */
+{
+  MPI_Status_int MPI_SOURCE;    /* Fortran: status(MPI_SOURCE) */
+  MPI_Status_int MPI_TAG;       /* Fortran: status(MPI_TAG) */
+  MPI_Status_int MPI_ERROR;     /* Fortran: status(MPI_ERROR) */
+
+} MPI_Status;
+
+
+/*
+ * Collective operations
+ */
+
+
+typedef int MPI_Op;
+
+typedef void MPI_User_function( void *invec, void *inoutvec, int *len,
+				MPI_Datatype *datatype); 
+
+#define MPI_OP_NULL (0)
+
+#define MPI_MAX     (0)
+#define MPI_MIN     (0)
+#define MPI_SUM     (0)
+#define MPI_PROD    (0)
+#define MPI_LAND    (0)
+#define MPI_BAND    (0)
+#define MPI_LOR     (0)
+#define MPI_BOR     (0)
+#define MPI_LXOR    (0)
+#define MPI_BXOR    (0)
+#define MPI_MAXLOC  (0)
+#define MPI_MINLOC  (0)
+
+
+
+/*
+ * These are provided for Fortran...
+ */
+
+
+#define MPI_INTEGER           MPI_INT
+#define MPI_REAL              MPI_FLOAT
+#define MPI_DOUBLE_PRECISION  MPI_DOUBLE
+
+#define MPI_STATUS_SIZE       (sizeof(MPI_Status) / sizeof(int))
+
+
+/**********************************************************
+ *
+ * Note: if you need to regenerate the prototypes below,
+ * you can use 'protify.awk' and paste the output here.
+ *
+ */                                                      
+
+
+extern int MPI_Barrier(MPI_Comm comm );
+extern int MPI_Bcast(void* buffer, int count, MPI_Datatype datatype,
+                     int root, MPI_Comm comm );
+extern int MPI_Gather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+                      void* recvbuf, int recvcount, MPI_Datatype recvtype,
+                      int root, MPI_Comm comm);
+extern int MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype, 
+                       void* recvbuf, int *recvcounts, int *displs,
+                       MPI_Datatype recvtype, int root, MPI_Comm comm);
+extern int MPI_Allgather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+                         void* recvbuf, int recvcount, MPI_Datatype recvtype,
+                         MPI_Comm comm);
+extern int MPI_Allgatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+                          void* recvbuf, int *recvcounts, int *displs,
+                          MPI_Datatype recvtype, MPI_Comm comm);
+extern int MPI_Scatter( void* sendbuf, int sendcount, MPI_Datatype sendtype, 
+                        void* recvbuf, int recvcount, MPI_Datatype recvtype,
+                        int root, MPI_Comm comm);
+extern int MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs, 
+                        MPI_Datatype sendtype, void* recvbuf, int recvcount, 
+                        MPI_Datatype recvtype, int root, MPI_Comm comm);
+extern int MPI_Reduce(void* sendbuf, void* recvbuf, int count, 
+                      MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm);
+extern int MPI_Allreduce(void* sendbuf, void* recvbuf, int count, 
+                         MPI_Datatype datatype, MPI_Op op, MPI_Comm comm);
+extern int MPI_Scan( void* sendbuf, void* recvbuf, int count, 
+                     MPI_Datatype datatype, MPI_Op op, MPI_Comm comm);
+extern int MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype sendtype,
+                        void *recvbuf, int recvcount, MPI_Datatype recvtype,
+                        MPI_Comm comm);
+extern int MPI_Alltoallv(void *sendbuf, int *sendcounts,
+                         int *sdispls, MPI_Datatype sendtype,
+                         void *recvbuf, int *recvcounts,
+                         int *rdispls, MPI_Datatype recvtype,
+                         MPI_Comm comm) ;
+extern int MPI_Op_create(MPI_User_function *function, int commute, 
+                         MPI_Op *op);
+extern MPI_Op MPI_Op_f2c(MPI_Fint op);
+extern MPI_Fint MPI_Op_c2f(MPI_Op op);
+extern MPI_Comm mpi_comm_new(void);
+extern int MPI_Comm_free(MPI_Comm *comm);
+extern int MPI_Comm_size(MPI_Comm comm, int *size);
+extern int MPI_Comm_rank(MPI_Comm comm, int *rank);
+extern int MPI_Comm_dup(MPI_Comm comm, MPI_Comm *newcomm);
+extern int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm);
+extern int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm);
+extern int MPI_Comm_group(MPI_Comm comm, MPI_Group *group);
+extern MPI_Comm MPI_Comm_f2c(MPI_Fint comm);
+extern MPI_Fint MPI_Comm_c2f(MPI_Comm comm);
+extern int MPI_Group_incl(MPI_Group group, int n, int *ranks, MPI_Group *newgroup);
+extern int MPI_Group_range_incl(MPI_Group group, int n, int ranges[][3],
+                                MPI_Group *newgroup);
+extern int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup);
+extern int MPI_Group_intersection(MPI_Group group1, MPI_Group group2,
+                                  MPI_Group *newgroup);
+extern int MPI_Group_difference(MPI_Group group1, MPI_Group group2,
+                                MPI_Group *newgroup);
+extern int MPI_Group_free(MPI_Group *group);
+extern int MPI_Group_translate_ranks(MPI_Group group1, int n, int *ranks1,
+                                     MPI_Group group2, int *ranks2);
+extern MPI_Group MPI_Group_f2c(MPI_Fint group);
+extern MPI_Fint MPI_Group_c2f(MPI_Group group);
+
+extern int MPI_Init(int *argc, char **argv[]) ;
+extern int MPI_Finalize(void);
+extern int MPI_Abort(MPI_Comm comm, int errorcode);
+extern int MPI_Error_string(int errorcode, char *string, int *resultlen);
+extern int MPI_Get_processor_name(char *name, int *resultlen);
+extern int MPI_Initialized(int *flag);
+extern int MPI_Pack( void *inbuf, int incount, MPI_Datatype datatype,
+                     void *outbuf, int outsize, int *position, MPI_Comm comm);
+extern int MPI_Unpack( void *inbuf, int insize, int *position,
+                       void *outbuf, int outcount, MPI_Datatype datatype,
+                       MPI_Comm comm );
+extern int MPI_Irecv(void *buf, int count, MPI_Datatype datatype,
+                     int source, int tag, MPI_Comm comm, MPI_Request *request);
+extern int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source,
+                    int tag, MPI_Comm comm, MPI_Status *status);
+
+extern int MPI_Test(MPI_Request *request, int *flag, MPI_Status *status);
+extern int MPI_Wait(MPI_Request *request, MPI_Status *status);
+extern int MPI_Waitany(int count, MPI_Request *array_of_requests,
+                       int *index, MPI_Status *status);
+extern int MPI_Waitall(int count, MPI_Request *array_of_requests,
+                       MPI_Status *array_of_statuses);
+extern MPI_Request MPI_Request_f2c(MPI_Fint request);
+extern MPI_Fint MPI_Request_c2f(MPI_Request request);
+extern int MPI_Isend(void *buf, int count, MPI_Datatype datatype,
+                     int dest, int tag, MPI_Comm comm, MPI_Request *request) ;
+extern int MPI_Send(void* buf, int count, MPI_Datatype datatype,
+                    int dest, int tag, MPI_Comm comm);
+extern int MPI_Ssend(void* buf, int count, MPI_Datatype datatype,
+                     int dest, int tag, MPI_Comm comm);
+extern int MPI_Rsend(void* buf, int count, MPI_Datatype datatype,
+                     int dest, int tag, MPI_Comm comm);
+extern int MPI_Irsend(void *buf, int count, MPI_Datatype datatype,
+                     int dest, int tag, MPI_Comm comm, MPI_Request *request) ;
+extern int MPI_Sendrecv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+			int dest, int sendtag,
+			void *recvbuf, int recvcount, MPI_Datatype recvtype,
+			int source, int recvtag,
+			MPI_Comm comm, MPI_Status *status);
+extern double MPI_Wtime(void);;
+extern double MPI_Wtime(void);
+
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpiP.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpiP.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpiP.h	(revision 4775)
@@ -0,0 +1,64 @@
+
+/*
+ * Private .h file for MPI
+ */
+
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "listops.h"
+#include "mpi.h"
+#include "config.h"
+
+/*
+ * MPI_GROUP_ONE must not conflict with MPI_GROUP_NULL or
+ * MPI_GROUP_EMPTY
+ */
+
+#define MPI_GROUP_ONE  (1)
+
+
+/****************************************************************************/
+
+
+typedef struct
+{
+  pList sendlist;
+  pList recvlist;
+
+  int num;
+
+} Comm;
+
+
+
+typedef struct
+{
+  pListitem listitem;        /* to allow Req to be removed from list */
+
+  int *buf;
+  int source;
+  int tag;
+  int complete;
+
+} Req;
+
+
+
+
+/****************************************************************************/
+
+
+extern void *mpi_malloc(int size);
+extern void mpi_free(void *ptr);
+
+extern MPI_Comm mpi_comm_new(void);
+
+extern void mpi_destroy_handles(void);
+extern void mpi_alloc_handle(int *handle, void **data);
+extern void *mpi_handle_to_ptr(int handle);
+extern void mpi_free_handle(int handle);
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.master.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.master.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.master.h	(revision 4775)
@@ -0,0 +1,268 @@
+
+!!!
+!!!   NOTE: The files mpif.realXdoubleY.h are generated from
+!!!   mpif.master.h using make-mpif and later copied to mpif.h
+!!!   during the library make.  All modifications should be
+!!!   made to mpif.master.h
+!!!
+
+
+!
+! MPI_COMM_WORLD
+!
+
+	INTEGER MPI_COMM_WORLD
+        parameter (mpi_comm_world=1)
+
+!
+!
+!
+
+        integer MPI_BOTTOM
+        parameter (MPI_BOTTOM=0)
+
+
+!
+! source,tag
+!
+
+	integer MPI_ANY_SOURCE, MPI_ANY_TAG
+        parameter (mpi_any_source=-1, mpi_any_tag= -1)
+
+        integer MPI_PROC_NULL, MPI_ROOT
+        parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3)
+
+        integer MPI_COMM_NULL, MPI_REQUEST_NULL
+        parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0)
+
+        integer MPI_GROUP_NULL, MPI_GROUP_EMPTY
+        parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1)
+
+        integer MPI_MAX_ERROR_STRING
+        parameter (MPI_MAX_ERROR_STRING=128)
+
+        integer MPI_MAX_PROCESSOR_NAME
+        parameter (MPI_MAX_PROCESSOR_NAME=128)
+
+!
+! Return codes
+!
+
+        integer MPI_SUCCESS
+        parameter (MPI_SUCCESS=0)
+
+        integer MPI_ERR_BUFFER 
+        parameter (MPI_ERR_BUFFER= -1)
+
+        integer MPI_ERR_COUNT 
+        parameter (MPI_ERR_COUNT= -1)
+
+        integer MPI_ERR_TYPE 
+        parameter (MPI_ERR_TYPE= -1)
+
+        integer MPI_ERR_TAG
+        parameter (MPI_ERR_TAG= -1)
+
+        integer MPI_ERR_COMM 
+        parameter (MPI_ERR_COMM= -1)
+
+        integer MPI_ERR_RANK 
+        parameter (MPI_ERR_RANK= -1)
+
+        integer MPI_ERR_REQUEST 
+        parameter (MPI_ERR_REQUEST= -1)
+
+        integer MPI_ERR_ROOT 
+        parameter (MPI_ERR_ROOT= -1)
+
+        integer MPI_ERR_GROUP 
+        parameter (MPI_ERR_GROUP= -1)
+
+        integer MPI_ERR_OP 
+        parameter (MPI_ERR_OP= -1)
+
+        integer MPI_ERR_TOPOLOGY 
+        parameter (MPI_ERR_TOPOLOGY= -1)
+
+        integer MPI_ERR_DIMS 
+        parameter (MPI_ERR_DIMS= -1)
+
+        integer MPI_ERR_ARG 
+        parameter (MPI_ERR_ARG= -1)
+
+        integer MPI_ERR_UNKNOWN 
+        parameter (MPI_ERR_UNKNOWN= -1)
+
+        integer MPI_ERR_TRUNCATE 
+        parameter (MPI_ERR_TRUNCATE= -1)
+
+        integer MPI_ERR_OTHER 
+        parameter (MPI_ERR_OTHER= -1)
+
+        integer MPI_ERR_INTERN 
+        parameter (MPI_ERR_INTERN= -1)
+
+        integer MPI_PENDING 
+        parameter (MPI_PENDING= -1)
+
+        integer MPI_ERR_IN_STATUS 
+        parameter (MPI_ERR_IN_STATUS= -1)
+
+        integer MPI_ERR_LASTCODE 
+        parameter (MPI_ERR_LASTCODE= -1)
+
+!
+!
+
+
+        integer MPI_UNDEFINED
+        parameter (MPI_UNDEFINED= -1)
+
+
+!
+! MPI_Status
+!
+! The values in this section MUST match the struct definition
+! in mpi.h
+!
+
+
+        INTEGER MPI_STATUS_SIZE
+        PARAMETER (MPI_STATUS_SIZE=3)
+
+        INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+        PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3)
+
+
+
+!
+! MPI_Datatype values
+!  
+! The value is the size of the datatype in bytes.
+! Change if necessary for the machine in question.
+! (The mpi.h file uses sizeof(), so it should be more
+! portable).
+! 
+!
+
+
+	INTEGER MPI_DATATYPE_NULL
+	PARAMETER (MPI_DATATYPE_NULL=0)
+
+	INTEGER MPI_BYTE
+	PARAMETER (MPI_BYTE=1)
+
+	INTEGER MPI_CHARACTER
+	PARAMETER (MPI_CHARACTER=1)
+
+	INTEGER MPI_INTEGER
+	PARAMETER (MPI_INTEGER=4)
+
+	INTEGER MPI_LOGICAL
+	PARAMETER (MPI_LOGICAL=4)
+
+!!!!!!!
+	INTEGER MPI_REAL
+	PARAMETER (MPI_REAL=_RSIZE_)
+
+	INTEGER MPI_DOUBLE_PRECISION
+	PARAMETER (MPI_DOUBLE_PRECISION=_DSIZE_)
+!!!!!!!
+
+	integer MPI_COMPLEX
+	parameter (MPI_COMPLEX=2*MPI_REAL)
+
+        integer MPI_2REAL
+        parameter (MPI_2REAL=2*MPI_REAL)
+
+        integer MPI_2DOUBLE_PRECISION
+        parameter (MPI_2DOUBLE_PRECISION=2*MPI_DOUBLE_PRECISION)
+
+        integer MPI_2INTEGER
+        parameter (MPI_2INTEGER=2*MPI_INTEGER)
+
+        integer MPI_PACKED
+        parameter (MPI_PACKED=1)
+
+
+!
+! Size-specific types
+!
+
+	INTEGER MPI_REAL4
+	PARAMETER (MPI_REAL4=4)
+
+	INTEGER MPI_REAL8
+	PARAMETER (MPI_REAL8=8)
+
+	INTEGER MPI_REAL16
+	PARAMETER (MPI_REAL16=16)
+
+
+	integer MPI_COMPLEX8
+        parameter (MPI_COMPLEX8=8)
+
+	integer MPI_COMPLEX16
+        parameter (MPI_COMPLEX16=16)
+
+	integer MPI_COMPLEX32
+        parameter (MPI_COMPLEX32=32)
+
+
+	INTEGER MPI_INTEGER1
+	PARAMETER (MPI_INTEGER1=1)
+
+	INTEGER MPI_INTEGER2
+	PARAMETER (MPI_INTEGER2=2)
+
+	INTEGER MPI_INTEGER4
+	PARAMETER (MPI_INTEGER4=4)
+
+	INTEGER MPI_INTEGER8
+	PARAMETER (MPI_INTEGER8=8)
+
+	INTEGER MPI_INTEGER16
+	PARAMETER (MPI_INTEGER16=16)
+
+
+        
+!
+! MPI_Op values
+!
+! (All are handled as no-op so no value is necessary)
+!
+
+        INTEGER MPI_SUM, MPI_MAX, MPI_MIN, MPI_PROD, MPI_LAND, MPI_BAND
+        INTEGER MPI_LOR, MPI_BOR, MPI_LXOR, MPI_BXOR, MPI_MINLOC
+        INTEGER MPI_MAXLOC
+        INTEGER MPI_OP_NULL
+
+!
+! MPI_Wtime
+!
+
+        DOUBLE PRECISION MPI_WTIME
+        EXTERNAL MPI_WTIME
+
+
+!
+! Kinds
+!
+
+	INTEGER MPI_OFFSET_KIND
+	PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13))
+
+	INTEGER MPI_INFO_NULL
+	PARAMETER (MPI_INFO_NULL=0)
+
+	INTEGER MPI_MODE_RDONLY
+	PARAMETER (MPI_MODE_RDONLY=0)
+
+        INTEGER MPI_MODE_CREATE
+        PARAMETER (MPI_MODE_CREATE=1)
+
+        INTEGER MPI_MODE_RDWR
+        PARAMETER (MPI_MODE_RDWR=2)
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real4double8.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real4double8.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real4double8.h	(revision 4775)
@@ -0,0 +1,268 @@
+
+!!!
+!!!   NOTE: The files mpif.realXdoubleY.h are generated from
+!!!   mpif.master.h using make-mpif and later copied to mpif.h
+!!!   during the library make.  All modifications should be
+!!!   made to mpif.master.h
+!!!
+
+
+!
+! MPI_COMM_WORLD
+!
+
+	INTEGER MPI_COMM_WORLD
+        parameter (mpi_comm_world=1)
+
+!
+!
+!
+
+        integer MPI_BOTTOM
+        parameter (MPI_BOTTOM=0)
+
+
+!
+! source,tag
+!
+
+	integer MPI_ANY_SOURCE, MPI_ANY_TAG
+        parameter (mpi_any_source=-1, mpi_any_tag= -1)
+
+        integer MPI_PROC_NULL, MPI_ROOT
+        parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3)
+
+        integer MPI_COMM_NULL, MPI_REQUEST_NULL
+        parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0)
+
+        integer MPI_GROUP_NULL, MPI_GROUP_EMPTY
+        parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1)
+
+        integer MPI_MAX_ERROR_STRING
+        parameter (MPI_MAX_ERROR_STRING=128)
+
+        integer MPI_MAX_PROCESSOR_NAME
+        parameter (MPI_MAX_PROCESSOR_NAME=128)
+
+!
+! Return codes
+!
+
+        integer MPI_SUCCESS
+        parameter (MPI_SUCCESS=0)
+
+        integer MPI_ERR_BUFFER 
+        parameter (MPI_ERR_BUFFER= -1)
+
+        integer MPI_ERR_COUNT 
+        parameter (MPI_ERR_COUNT= -1)
+
+        integer MPI_ERR_TYPE 
+        parameter (MPI_ERR_TYPE= -1)
+
+        integer MPI_ERR_TAG
+        parameter (MPI_ERR_TAG= -1)
+
+        integer MPI_ERR_COMM 
+        parameter (MPI_ERR_COMM= -1)
+
+        integer MPI_ERR_RANK 
+        parameter (MPI_ERR_RANK= -1)
+
+        integer MPI_ERR_REQUEST 
+        parameter (MPI_ERR_REQUEST= -1)
+
+        integer MPI_ERR_ROOT 
+        parameter (MPI_ERR_ROOT= -1)
+
+        integer MPI_ERR_GROUP 
+        parameter (MPI_ERR_GROUP= -1)
+
+        integer MPI_ERR_OP 
+        parameter (MPI_ERR_OP= -1)
+
+        integer MPI_ERR_TOPOLOGY 
+        parameter (MPI_ERR_TOPOLOGY= -1)
+
+        integer MPI_ERR_DIMS 
+        parameter (MPI_ERR_DIMS= -1)
+
+        integer MPI_ERR_ARG 
+        parameter (MPI_ERR_ARG= -1)
+
+        integer MPI_ERR_UNKNOWN 
+        parameter (MPI_ERR_UNKNOWN= -1)
+
+        integer MPI_ERR_TRUNCATE 
+        parameter (MPI_ERR_TRUNCATE= -1)
+
+        integer MPI_ERR_OTHER 
+        parameter (MPI_ERR_OTHER= -1)
+
+        integer MPI_ERR_INTERN 
+        parameter (MPI_ERR_INTERN= -1)
+
+        integer MPI_PENDING 
+        parameter (MPI_PENDING= -1)
+
+        integer MPI_ERR_IN_STATUS 
+        parameter (MPI_ERR_IN_STATUS= -1)
+
+        integer MPI_ERR_LASTCODE 
+        parameter (MPI_ERR_LASTCODE= -1)
+
+!
+!
+
+
+        integer MPI_UNDEFINED
+        parameter (MPI_UNDEFINED= -1)
+
+
+!
+! MPI_Status
+!
+! The values in this section MUST match the struct definition
+! in mpi.h
+!
+
+
+        INTEGER MPI_STATUS_SIZE
+        PARAMETER (MPI_STATUS_SIZE=3)
+
+        INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+        PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3)
+
+
+
+!
+! MPI_Datatype values
+!  
+! The value is the size of the datatype in bytes.
+! Change if necessary for the machine in question.
+! (The mpi.h file uses sizeof(), so it should be more
+! portable).
+! 
+!
+
+
+	INTEGER MPI_DATATYPE_NULL
+	PARAMETER (MPI_DATATYPE_NULL=0)
+
+	INTEGER MPI_BYTE
+	PARAMETER (MPI_BYTE=1)
+
+	INTEGER MPI_CHARACTER
+	PARAMETER (MPI_CHARACTER=1)
+
+	INTEGER MPI_INTEGER
+	PARAMETER (MPI_INTEGER=4)
+
+	INTEGER MPI_LOGICAL
+	PARAMETER (MPI_LOGICAL=4)
+
+!!!!!!!
+	INTEGER MPI_REAL
+	PARAMETER (MPI_REAL=4)
+
+	INTEGER MPI_DOUBLE_PRECISION
+	PARAMETER (MPI_DOUBLE_PRECISION=8)
+!!!!!!!
+
+	integer MPI_COMPLEX
+	parameter (MPI_COMPLEX=2*MPI_REAL)
+
+        integer MPI_2REAL
+        parameter (MPI_2REAL=2*MPI_REAL)
+
+        integer MPI_2DOUBLE_PRECISION
+        parameter (MPI_2DOUBLE_PRECISION=2*MPI_DOUBLE_PRECISION)
+
+        integer MPI_2INTEGER
+        parameter (MPI_2INTEGER=2*MPI_INTEGER)
+
+        integer MPI_PACKED
+        parameter (MPI_PACKED=1)
+
+
+!
+! Size-specific types
+!
+
+	INTEGER MPI_REAL4
+	PARAMETER (MPI_REAL4=4)
+
+	INTEGER MPI_REAL8
+	PARAMETER (MPI_REAL8=8)
+
+	INTEGER MPI_REAL16
+	PARAMETER (MPI_REAL16=16)
+
+
+	integer MPI_COMPLEX8
+        parameter (MPI_COMPLEX8=8)
+
+	integer MPI_COMPLEX16
+        parameter (MPI_COMPLEX16=16)
+
+	integer MPI_COMPLEX32
+        parameter (MPI_COMPLEX32=32)
+
+
+	INTEGER MPI_INTEGER1
+	PARAMETER (MPI_INTEGER1=1)
+
+	INTEGER MPI_INTEGER2
+	PARAMETER (MPI_INTEGER2=2)
+
+	INTEGER MPI_INTEGER4
+	PARAMETER (MPI_INTEGER4=4)
+
+	INTEGER MPI_INTEGER8
+	PARAMETER (MPI_INTEGER8=8)
+
+	INTEGER MPI_INTEGER16
+	PARAMETER (MPI_INTEGER16=16)
+
+
+        
+!
+! MPI_Op values
+!
+! (All are handled as no-op so no value is necessary)
+!
+
+        INTEGER MPI_SUM, MPI_MAX, MPI_MIN, MPI_PROD, MPI_LAND, MPI_BAND
+        INTEGER MPI_LOR, MPI_BOR, MPI_LXOR, MPI_BXOR, MPI_MINLOC
+        INTEGER MPI_MAXLOC
+        INTEGER MPI_OP_NULL
+
+!
+! MPI_Wtime
+!
+
+        DOUBLE PRECISION MPI_WTIME
+        EXTERNAL MPI_WTIME
+
+
+!
+! Kinds
+!
+
+	INTEGER MPI_OFFSET_KIND
+	PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13))
+
+	INTEGER MPI_INFO_NULL
+	PARAMETER (MPI_INFO_NULL=0)
+
+	INTEGER MPI_MODE_RDONLY
+	PARAMETER (MPI_MODE_RDONLY=0)
+
+        INTEGER MPI_MODE_CREATE
+        PARAMETER (MPI_MODE_CREATE=1)
+
+        INTEGER MPI_MODE_RDWR
+        PARAMETER (MPI_MODE_RDWR=2)
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double16.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double16.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double16.h	(revision 4775)
@@ -0,0 +1,268 @@
+
+!!!
+!!!   NOTE: The files mpif.realXdoubleY.h are generated from
+!!!   mpif.master.h using make-mpif and later copied to mpif.h
+!!!   during the library make.  All modifications should be
+!!!   made to mpif.master.h
+!!!
+
+
+!
+! MPI_COMM_WORLD
+!
+
+	INTEGER MPI_COMM_WORLD
+        parameter (mpi_comm_world=1)
+
+!
+!
+!
+
+        integer MPI_BOTTOM
+        parameter (MPI_BOTTOM=0)
+
+
+!
+! source,tag
+!
+
+	integer MPI_ANY_SOURCE, MPI_ANY_TAG
+        parameter (mpi_any_source=-1, mpi_any_tag= -1)
+
+        integer MPI_PROC_NULL, MPI_ROOT
+        parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3)
+
+        integer MPI_COMM_NULL, MPI_REQUEST_NULL
+        parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0)
+
+        integer MPI_GROUP_NULL, MPI_GROUP_EMPTY
+        parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1)
+
+        integer MPI_MAX_ERROR_STRING
+        parameter (MPI_MAX_ERROR_STRING=128)
+
+        integer MPI_MAX_PROCESSOR_NAME
+        parameter (MPI_MAX_PROCESSOR_NAME=128)
+
+!
+! Return codes
+!
+
+        integer MPI_SUCCESS
+        parameter (MPI_SUCCESS=0)
+
+        integer MPI_ERR_BUFFER 
+        parameter (MPI_ERR_BUFFER= -1)
+
+        integer MPI_ERR_COUNT 
+        parameter (MPI_ERR_COUNT= -1)
+
+        integer MPI_ERR_TYPE 
+        parameter (MPI_ERR_TYPE= -1)
+
+        integer MPI_ERR_TAG
+        parameter (MPI_ERR_TAG= -1)
+
+        integer MPI_ERR_COMM 
+        parameter (MPI_ERR_COMM= -1)
+
+        integer MPI_ERR_RANK 
+        parameter (MPI_ERR_RANK= -1)
+
+        integer MPI_ERR_REQUEST 
+        parameter (MPI_ERR_REQUEST= -1)
+
+        integer MPI_ERR_ROOT 
+        parameter (MPI_ERR_ROOT= -1)
+
+        integer MPI_ERR_GROUP 
+        parameter (MPI_ERR_GROUP= -1)
+
+        integer MPI_ERR_OP 
+        parameter (MPI_ERR_OP= -1)
+
+        integer MPI_ERR_TOPOLOGY 
+        parameter (MPI_ERR_TOPOLOGY= -1)
+
+        integer MPI_ERR_DIMS 
+        parameter (MPI_ERR_DIMS= -1)
+
+        integer MPI_ERR_ARG 
+        parameter (MPI_ERR_ARG= -1)
+
+        integer MPI_ERR_UNKNOWN 
+        parameter (MPI_ERR_UNKNOWN= -1)
+
+        integer MPI_ERR_TRUNCATE 
+        parameter (MPI_ERR_TRUNCATE= -1)
+
+        integer MPI_ERR_OTHER 
+        parameter (MPI_ERR_OTHER= -1)
+
+        integer MPI_ERR_INTERN 
+        parameter (MPI_ERR_INTERN= -1)
+
+        integer MPI_PENDING 
+        parameter (MPI_PENDING= -1)
+
+        integer MPI_ERR_IN_STATUS 
+        parameter (MPI_ERR_IN_STATUS= -1)
+
+        integer MPI_ERR_LASTCODE 
+        parameter (MPI_ERR_LASTCODE= -1)
+
+!
+!
+
+
+        integer MPI_UNDEFINED
+        parameter (MPI_UNDEFINED= -1)
+
+
+!
+! MPI_Status
+!
+! The values in this section MUST match the struct definition
+! in mpi.h
+!
+
+
+        INTEGER MPI_STATUS_SIZE
+        PARAMETER (MPI_STATUS_SIZE=3)
+
+        INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+        PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3)
+
+
+
+!
+! MPI_Datatype values
+!  
+! The value is the size of the datatype in bytes.
+! Change if necessary for the machine in question.
+! (The mpi.h file uses sizeof(), so it should be more
+! portable).
+! 
+!
+
+
+	INTEGER MPI_DATATYPE_NULL
+	PARAMETER (MPI_DATATYPE_NULL=0)
+
+	INTEGER MPI_BYTE
+	PARAMETER (MPI_BYTE=1)
+
+	INTEGER MPI_CHARACTER
+	PARAMETER (MPI_CHARACTER=1)
+
+	INTEGER MPI_INTEGER
+	PARAMETER (MPI_INTEGER=4)
+
+	INTEGER MPI_LOGICAL
+	PARAMETER (MPI_LOGICAL=4)
+
+!!!!!!!
+	INTEGER MPI_REAL
+	PARAMETER (MPI_REAL=8)
+
+	INTEGER MPI_DOUBLE_PRECISION
+	PARAMETER (MPI_DOUBLE_PRECISION=16)
+!!!!!!!
+
+	integer MPI_COMPLEX
+	parameter (MPI_COMPLEX=2*MPI_REAL)
+
+        integer MPI_2REAL
+        parameter (MPI_2REAL=2*MPI_REAL)
+
+        integer MPI_2DOUBLE_PRECISION
+        parameter (MPI_2DOUBLE_PRECISION=2*MPI_DOUBLE_PRECISION)
+
+        integer MPI_2INTEGER
+        parameter (MPI_2INTEGER=2*MPI_INTEGER)
+
+        integer MPI_PACKED
+        parameter (MPI_PACKED=1)
+
+
+!
+! Size-specific types
+!
+
+	INTEGER MPI_REAL4
+	PARAMETER (MPI_REAL4=4)
+
+	INTEGER MPI_REAL8
+	PARAMETER (MPI_REAL8=8)
+
+	INTEGER MPI_REAL16
+	PARAMETER (MPI_REAL16=16)
+
+
+	integer MPI_COMPLEX8
+        parameter (MPI_COMPLEX8=8)
+
+	integer MPI_COMPLEX16
+        parameter (MPI_COMPLEX16=16)
+
+	integer MPI_COMPLEX32
+        parameter (MPI_COMPLEX32=32)
+
+
+	INTEGER MPI_INTEGER1
+	PARAMETER (MPI_INTEGER1=1)
+
+	INTEGER MPI_INTEGER2
+	PARAMETER (MPI_INTEGER2=2)
+
+	INTEGER MPI_INTEGER4
+	PARAMETER (MPI_INTEGER4=4)
+
+	INTEGER MPI_INTEGER8
+	PARAMETER (MPI_INTEGER8=8)
+
+	INTEGER MPI_INTEGER16
+	PARAMETER (MPI_INTEGER16=16)
+
+
+        
+!
+! MPI_Op values
+!
+! (All are handled as no-op so no value is necessary)
+!
+
+        INTEGER MPI_SUM, MPI_MAX, MPI_MIN, MPI_PROD, MPI_LAND, MPI_BAND
+        INTEGER MPI_LOR, MPI_BOR, MPI_LXOR, MPI_BXOR, MPI_MINLOC
+        INTEGER MPI_MAXLOC
+        INTEGER MPI_OP_NULL
+
+!
+! MPI_Wtime
+!
+
+        DOUBLE PRECISION MPI_WTIME
+        EXTERNAL MPI_WTIME
+
+
+!
+! Kinds
+!
+
+	INTEGER MPI_OFFSET_KIND
+	PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13))
+
+	INTEGER MPI_INFO_NULL
+	PARAMETER (MPI_INFO_NULL=0)
+
+	INTEGER MPI_MODE_RDONLY
+	PARAMETER (MPI_MODE_RDONLY=0)
+
+        INTEGER MPI_MODE_CREATE
+        PARAMETER (MPI_MODE_CREATE=1)
+
+        INTEGER MPI_MODE_RDWR
+        PARAMETER (MPI_MODE_RDWR=2)
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double8.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double8.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/mpif.real8double8.h	(revision 4775)
@@ -0,0 +1,268 @@
+
+!!!
+!!!   NOTE: The files mpif.realXdoubleY.h are generated from
+!!!   mpif.master.h using make-mpif and later copied to mpif.h
+!!!   during the library make.  All modifications should be
+!!!   made to mpif.master.h
+!!!
+
+
+!
+! MPI_COMM_WORLD
+!
+
+	INTEGER MPI_COMM_WORLD
+        parameter (mpi_comm_world=1)
+
+!
+!
+!
+
+        integer MPI_BOTTOM
+        parameter (MPI_BOTTOM=0)
+
+
+!
+! source,tag
+!
+
+	integer MPI_ANY_SOURCE, MPI_ANY_TAG
+        parameter (mpi_any_source=-1, mpi_any_tag= -1)
+
+        integer MPI_PROC_NULL, MPI_ROOT
+        parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3)
+
+        integer MPI_COMM_NULL, MPI_REQUEST_NULL
+        parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0)
+
+        integer MPI_GROUP_NULL, MPI_GROUP_EMPTY
+        parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1)
+
+        integer MPI_MAX_ERROR_STRING
+        parameter (MPI_MAX_ERROR_STRING=128)
+
+        integer MPI_MAX_PROCESSOR_NAME
+        parameter (MPI_MAX_PROCESSOR_NAME=128)
+
+!
+! Return codes
+!
+
+        integer MPI_SUCCESS
+        parameter (MPI_SUCCESS=0)
+
+        integer MPI_ERR_BUFFER 
+        parameter (MPI_ERR_BUFFER= -1)
+
+        integer MPI_ERR_COUNT 
+        parameter (MPI_ERR_COUNT= -1)
+
+        integer MPI_ERR_TYPE 
+        parameter (MPI_ERR_TYPE= -1)
+
+        integer MPI_ERR_TAG
+        parameter (MPI_ERR_TAG= -1)
+
+        integer MPI_ERR_COMM 
+        parameter (MPI_ERR_COMM= -1)
+
+        integer MPI_ERR_RANK 
+        parameter (MPI_ERR_RANK= -1)
+
+        integer MPI_ERR_REQUEST 
+        parameter (MPI_ERR_REQUEST= -1)
+
+        integer MPI_ERR_ROOT 
+        parameter (MPI_ERR_ROOT= -1)
+
+        integer MPI_ERR_GROUP 
+        parameter (MPI_ERR_GROUP= -1)
+
+        integer MPI_ERR_OP 
+        parameter (MPI_ERR_OP= -1)
+
+        integer MPI_ERR_TOPOLOGY 
+        parameter (MPI_ERR_TOPOLOGY= -1)
+
+        integer MPI_ERR_DIMS 
+        parameter (MPI_ERR_DIMS= -1)
+
+        integer MPI_ERR_ARG 
+        parameter (MPI_ERR_ARG= -1)
+
+        integer MPI_ERR_UNKNOWN 
+        parameter (MPI_ERR_UNKNOWN= -1)
+
+        integer MPI_ERR_TRUNCATE 
+        parameter (MPI_ERR_TRUNCATE= -1)
+
+        integer MPI_ERR_OTHER 
+        parameter (MPI_ERR_OTHER= -1)
+
+        integer MPI_ERR_INTERN 
+        parameter (MPI_ERR_INTERN= -1)
+
+        integer MPI_PENDING 
+        parameter (MPI_PENDING= -1)
+
+        integer MPI_ERR_IN_STATUS 
+        parameter (MPI_ERR_IN_STATUS= -1)
+
+        integer MPI_ERR_LASTCODE 
+        parameter (MPI_ERR_LASTCODE= -1)
+
+!
+!
+
+
+        integer MPI_UNDEFINED
+        parameter (MPI_UNDEFINED= -1)
+
+
+!
+! MPI_Status
+!
+! The values in this section MUST match the struct definition
+! in mpi.h
+!
+
+
+        INTEGER MPI_STATUS_SIZE
+        PARAMETER (MPI_STATUS_SIZE=3)
+
+        INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+        PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3)
+
+
+
+!
+! MPI_Datatype values
+!  
+! The value is the size of the datatype in bytes.
+! Change if necessary for the machine in question.
+! (The mpi.h file uses sizeof(), so it should be more
+! portable).
+! 
+!
+
+
+	INTEGER MPI_DATATYPE_NULL
+	PARAMETER (MPI_DATATYPE_NULL=0)
+
+	INTEGER MPI_BYTE
+	PARAMETER (MPI_BYTE=1)
+
+	INTEGER MPI_CHARACTER
+	PARAMETER (MPI_CHARACTER=1)
+
+	INTEGER MPI_INTEGER
+	PARAMETER (MPI_INTEGER=4)
+
+	INTEGER MPI_LOGICAL
+	PARAMETER (MPI_LOGICAL=4)
+
+!!!!!!!
+	INTEGER MPI_REAL
+	PARAMETER (MPI_REAL=8)
+
+	INTEGER MPI_DOUBLE_PRECISION
+	PARAMETER (MPI_DOUBLE_PRECISION=8)
+!!!!!!!
+
+	integer MPI_COMPLEX
+	parameter (MPI_COMPLEX=2*MPI_REAL)
+
+        integer MPI_2REAL
+        parameter (MPI_2REAL=2*MPI_REAL)
+
+        integer MPI_2DOUBLE_PRECISION
+        parameter (MPI_2DOUBLE_PRECISION=2*MPI_DOUBLE_PRECISION)
+
+        integer MPI_2INTEGER
+        parameter (MPI_2INTEGER=2*MPI_INTEGER)
+
+        integer MPI_PACKED
+        parameter (MPI_PACKED=1)
+
+
+!
+! Size-specific types
+!
+
+	INTEGER MPI_REAL4
+	PARAMETER (MPI_REAL4=4)
+
+	INTEGER MPI_REAL8
+	PARAMETER (MPI_REAL8=8)
+
+	INTEGER MPI_REAL16
+	PARAMETER (MPI_REAL16=16)
+
+
+	integer MPI_COMPLEX8
+        parameter (MPI_COMPLEX8=8)
+
+	integer MPI_COMPLEX16
+        parameter (MPI_COMPLEX16=16)
+
+	integer MPI_COMPLEX32
+        parameter (MPI_COMPLEX32=32)
+
+
+	INTEGER MPI_INTEGER1
+	PARAMETER (MPI_INTEGER1=1)
+
+	INTEGER MPI_INTEGER2
+	PARAMETER (MPI_INTEGER2=2)
+
+	INTEGER MPI_INTEGER4
+	PARAMETER (MPI_INTEGER4=4)
+
+	INTEGER MPI_INTEGER8
+	PARAMETER (MPI_INTEGER8=8)
+
+	INTEGER MPI_INTEGER16
+	PARAMETER (MPI_INTEGER16=16)
+
+
+        
+!
+! MPI_Op values
+!
+! (All are handled as no-op so no value is necessary)
+!
+
+        INTEGER MPI_SUM, MPI_MAX, MPI_MIN, MPI_PROD, MPI_LAND, MPI_BAND
+        INTEGER MPI_LOR, MPI_BOR, MPI_LXOR, MPI_BXOR, MPI_MINLOC
+        INTEGER MPI_MAXLOC
+        INTEGER MPI_OP_NULL
+
+!
+! MPI_Wtime
+!
+
+        DOUBLE PRECISION MPI_WTIME
+        EXTERNAL MPI_WTIME
+
+
+!
+! Kinds
+!
+
+	INTEGER MPI_OFFSET_KIND
+	PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13))
+
+	INTEGER MPI_INFO_NULL
+	PARAMETER (MPI_INFO_NULL=0)
+
+	INTEGER MPI_MODE_RDONLY
+	PARAMETER (MPI_MODE_RDONLY=0)
+
+        INTEGER MPI_MODE_CREATE
+        PARAMETER (MPI_MODE_CREATE=1)
+
+        INTEGER MPI_MODE_RDWR
+        PARAMETER (MPI_MODE_RDWR=2)
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/pack.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/pack.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/pack.c	(revision 4775)
@@ -0,0 +1,76 @@
+
+#include "mpiP.h"
+
+/*
+ *
+ */
+
+
+FC_FUNC( mpi_pack , MPI_PACK )
+     ( void *inbuf, int *incount, int *datatype,
+       void *outbuf, int *outsize, int *position, int *comm, int *ierror)
+{
+  *ierror=MPI_Pack(inbuf, *incount,* datatype,
+		   outbuf, *outsize, position, *comm);
+}
+
+
+
+int MPI_Pack( void *inbuf, int incount, MPI_Datatype datatype,
+              void *outbuf, int outsize, int *position, MPI_Comm comm)
+{
+  int size;
+
+  size=datatype*incount;
+
+  if ( (*position)+size > outsize)
+    {
+      fprintf(stderr,"MPI_Pack: ran out of space in outbuf\n");
+      abort();
+    }
+
+  memcpy( (char *)outbuf+(*position), inbuf, size);
+  (*position)+=size;
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*
+ *
+ */
+
+
+FC_FUNC( mpi_unpack , MPI_UNPACK )
+     ( void *inbuf, int *insize, int *position,
+       void *outbuf, int *outcount, int *datatype,
+       int *comm, int *ierror )
+{
+  *ierror=MPI_Unpack( inbuf, *insize, position,
+                      outbuf, *outcount, *datatype, *comm);
+}
+
+
+
+int MPI_Unpack( void *inbuf, int insize, int *position,
+                void *outbuf, int outcount, MPI_Datatype datatype,
+                MPI_Comm comm )
+{
+  int size;
+
+  size=datatype*outcount;
+
+  if ( (*position)+size > insize )
+    {
+      fprintf(stderr,"MPI_Unpack: ran out of data in inbuf\n");
+      abort();
+    }
+
+
+  memcpy(outbuf, (char *)inbuf+(*position) , size);
+  (*position)+=size;
+
+  return(MPI_SUCCESS);
+
+}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/protify.awk
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/protify.awk	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/protify.awk	(revision 4775)
@@ -0,0 +1,46 @@
+#!/bin/awk -f
+
+
+#######################################################################
+#
+# Because of awk problems on the sgi, this file is converted to perl
+# via 'a2p' to yield 'protify'.  Do not edit the perl version!!!!
+#
+#######################################################################
+
+
+BEGIN {
+
+  printf("\n");
+  printf("/******************************************************  \n");
+  printf(" * WARNING: This file automatically generated.        *  \n");
+  printf(" ******************************************************  \n");
+  printf(" */                                                      \n");
+  printf("\n\n\n\n");
+}
+
+
+/[ \t]*extern/ { next }
+/main\(/ { next }
+
+/FORT_NAME/ {next}
+
+# Ignore doctext comments
+/\/\*[DMN@]/ { while (!match($0,/[DMN@]\*\//)) getline; next; }
+
+
+/^[^ \t{}/*#].*[^ \t]+\(.*[^;]*$/ \
+   {
+     if ($1=="static")
+       next;                   #continue;
+
+     printf("extern %s",$0);
+
+     while (!match($0,"\)"))
+       {
+         getline;
+	 gsub("\t","        ");
+         printf("\n       %s",$0);
+       }
+     printf(";\n");
+   }
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/recv.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/recv.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/recv.c	(revision 4775)
@@ -0,0 +1,161 @@
+
+#include "mpiP.h"
+
+
+
+/* 
+ * RECEIVING
+ *
+ */
+
+
+
+static int mpi_match_send(void *r, void *tag)
+{
+  return( *((int *)tag) == MPI_ANY_TAG ||
+	  *((int *)tag) == ((Req *)r)->tag );
+}
+
+
+
+/*
+ *
+ */
+
+
+
+FC_FUNC( mpi_irecv , MPI_IRECV )(void *buf, int *count, int *datatype,
+				   int *source, int *tag, int *comm,
+				   int *request, int *ierror)
+{
+
+  *ierror=MPI_Irecv(buf,*count,*datatype,*source,*tag,
+		    *comm, (void *)request);
+
+}
+
+
+
+int MPI_Irecv(void *buf, int count, MPI_Datatype datatype,
+	      int source, int tag, MPI_Comm comm, MPI_Request *request)
+
+{
+  pListitem match;
+  Comm *mycomm;
+  Req *rreq, *sreq;
+
+  mycomm=mpi_handle_to_ptr(comm);         /* mycomm=(Comm *)comm; */
+
+#ifdef INFO
+  fflush(stdout);
+  fprintf(stderr,"MPI_Irecv: Comm=%d  tag=%d  count=%d type=%d\n",
+	 mycomm->num,tag,count,datatype);
+#endif
+
+
+  if (source!=0 && source!=MPI_ANY_SOURCE && source!=MPI_PROC_NULL)
+    {
+      fprintf(stderr,"MPI_Irecv: bad source %d\n",source);
+      abort();
+    }
+
+  mpi_alloc_handle(request,(void **)&rreq);
+
+  if (source==MPI_PROC_NULL)
+    {
+      rreq->complete=1;
+      rreq->source=MPI_PROC_NULL;
+      rreq->tag=MPI_ANY_TAG;
+
+      return(MPI_SUCCESS);
+    }
+
+
+  if ( match=AP_list_search_func(mycomm->sendlist,mpi_match_send,&tag) )
+    {
+      sreq=(Req *)AP_listitem_data(match);
+      AP_list_delete_item(mycomm->sendlist,match);
+
+      memcpy(buf,sreq->buf,count * datatype);
+      rreq->complete=1;
+      rreq->source=0;
+      rreq->tag=sreq->tag;                   /* in case tag was MPI_ANY_TAG */
+
+      sreq->complete=1;
+
+#ifdef DEBUG
+      printf("Completion(recv) value=%d tag=%d\n",
+	     *((int *)buf),rreq->tag);
+#endif
+
+      return(MPI_SUCCESS);
+    }
+
+  rreq->buf=buf;
+  rreq->tag=tag;
+  rreq->complete=0;
+  rreq->listitem=AP_list_append(mycomm->recvlist,rreq);
+
+#ifdef INFO
+  print_list(mycomm->recvlist,"recvlist for comm ",mycomm->num);
+#endif
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_recv , MPI_RECV )(void *buf, int *count, int *datatype,
+				 int *source, int *tag, int *comm,
+				 int *status, int *ierror)
+{
+  *ierror=MPI_Recv(buf,*count,*datatype,*source,*tag,*comm,
+		   (MPI_Status *)status);
+}
+
+
+
+int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source,
+             int tag, MPI_Comm comm, MPI_Status *status)
+{
+  MPI_Request request;
+
+#ifdef INFO
+  fflush(stdout);
+  fprintf(stderr,"MPI_Recv: ");
+#endif
+
+
+  MPI_Irecv(buf,count,datatype,source,tag,comm,&request);
+  MPI_Wait(&request,status);
+
+
+  return(MPI_SUCCESS);
+}
+
+
+
+#ifdef INFO
+
+int print_item(void *item, void *data)
+{
+  fprintf(stderr,"%d  ", ((Req *)item)->tag);
+  return(0);
+}
+
+
+int print_list(pList list, char *msg, int num)
+{
+  fflush(stdout);
+  fprintf(stderr,"%s %d: ",msg,num);
+
+  AP_list_apply(list,print_item,NULL);
+
+  fprintf(stderr,"\n");
+  return(0);
+}
+
+
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/req.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/req.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/req.c	(revision 4775)
@@ -0,0 +1,156 @@
+#include "mpiP.h"
+
+
+/*
+ * COMPLETION
+ */
+
+
+
+FC_FUNC( mpi_test , MPI_TEST)(int *request, int *flag, int *status,
+				int *ierror)
+{
+  *ierror=MPI_Test( (void *)request ,flag,(MPI_Status *)status);
+}
+
+
+
+int MPI_Test(MPI_Request *request, int *flag, MPI_Status *status)
+{
+  Req *req;
+
+  if (*request==MPI_REQUEST_NULL)
+    {
+      status->MPI_TAG= MPI_ANY_TAG;
+      status->MPI_SOURCE= MPI_ANY_SOURCE;
+      *flag=1;
+      return(MPI_SUCCESS);
+    }
+
+
+  req=mpi_handle_to_ptr(*request);
+
+  *flag=req->complete;
+
+  if (*flag)
+    {
+      status->MPI_SOURCE= req->source;
+      status->MPI_TAG= req->tag;
+
+      mpi_free_handle(*request);
+      *request=MPI_REQUEST_NULL;
+    }
+
+  return(MPI_SUCCESS);
+}
+
+
+
+FC_FUNC( mpi_wait , MPI_WAIT )(int *request, int *status, int *ierror)
+{
+  *ierror=MPI_Wait( (void *)request, (MPI_Status *)status );
+}
+
+
+
+int MPI_Wait(MPI_Request *request, MPI_Status *status)
+{
+  int flag;
+
+  MPI_Test(request,&flag,status);
+
+  if (!flag)
+    {
+      fprintf(stderr,"MPI_Wait: request not complete, deadlock\n");
+      abort();
+    }
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_waitany , MPI_WAITANY )(int *count, int *requests,
+				       int *index, int *status, int *ierror)
+{
+
+  *ierror=MPI_Waitany(*count, (void *)requests,index,(MPI_Status *)status);
+}
+
+
+
+int MPI_Waitany(int count, MPI_Request *array_of_requests,
+		int *index, MPI_Status *status)
+{
+  int i;
+  int flag;
+
+  for (i=0; i<count; i++)
+    {
+      MPI_Test(&array_of_requests[i],&flag,status);
+      
+      if (flag)
+	return(MPI_SUCCESS);
+    }
+
+  /* none are completed */
+
+  fprintf(stderr,"MPI_Waitany: no requests complete, deadlock\n");
+  abort();
+}
+
+
+/*********/
+
+
+FC_FUNC( mpi_waitall , MPI_WAITALL )(int *count, int *array_of_requests,
+				       int *array_of_statuses, int *ierror)
+{
+  *ierror=MPI_Waitall(*count, (void *)array_of_requests,
+		      (MPI_Status *)array_of_statuses);
+
+}
+
+
+
+int MPI_Waitall(int count, MPI_Request *array_of_requests,
+		MPI_Status *array_of_statuses)
+{
+  int i;
+  int flag;
+
+  for (i=0; i<count; i++)
+    {
+      MPI_Test(&array_of_requests[i],&flag,&array_of_statuses[i]);
+
+      if (!flag)
+	{
+	  fprintf(stderr,"MPI_Waitall: request not complete, deadlock\n");
+	  abort();
+	}
+    }
+
+  return(MPI_SUCCESS);
+}
+
+
+
+/*********/
+
+
+MPI_Request MPI_Request_f2c(MPI_Fint request)
+{
+  return(request);
+}
+
+
+/*********/
+
+
+
+MPI_Fint MPI_Request_c2f(MPI_Request request)
+{
+  return(request);
+}
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/send.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/send.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/send.c	(revision 4775)
@@ -0,0 +1,250 @@
+
+#include "mpiP.h"
+
+
+/*
+ * SENDING
+ *
+ */
+
+
+
+static int mpi_match_recv(void *r, void *tag)
+{
+  return( ((Req *)r)->tag == MPI_ANY_TAG ||
+	  ((Req *)r)->tag == *((int *)tag) );
+}
+
+
+/*
+ *
+ */
+
+
+
+FC_FUNC( mpi_isend , MPI_ISEND )(void *buf, int *count, int *datatype,
+   int *dest, int *tag, int *comm, int *req, int *ierror)
+{
+
+  *ierror=MPI_Isend(buf,*count,*datatype,*dest,*tag,
+		    *comm, (void *)req);
+
+}
+
+
+
+int MPI_Isend(void *buf, int count, MPI_Datatype datatype,
+	      int dest, int tag, MPI_Comm comm, MPI_Request *request) 
+{
+  pListitem match;
+  Comm *mycomm;
+  Req *rreq, *sreq;
+
+  mycomm=mpi_handle_to_ptr(comm);   /* (Comm *)comm; */
+
+#ifdef INFO
+  fflush(stdout);
+  fprintf(stderr,"MPI_Isend: Comm=%d  tag=%d  count=%d type=%d\n",
+	 mycomm->num,tag,count,datatype);
+#endif
+
+  if (dest!=0 && dest!=MPI_PROC_NULL)
+    {
+      fprintf(stderr,"MPI_Isend: send to %d\n",dest);
+      abort();
+    }
+
+  mpi_alloc_handle(request,(void **) &sreq);
+
+
+  if (dest==MPI_PROC_NULL)
+    {
+      sreq->complete=1;
+      return(MPI_SUCCESS);
+    }
+
+  if ( match=AP_list_search_func(mycomm->recvlist,mpi_match_recv,&tag) )
+    {
+      rreq=(Req *)AP_listitem_data(match);
+      AP_list_delete_item(mycomm->recvlist,match);
+
+      memcpy(rreq->buf,buf,count * datatype);
+      rreq->complete=1;
+      rreq->source=0;
+      rreq->tag=tag;                    /* in case rreq->tag was MPI_ANY_TAG */
+
+      sreq->complete=1;
+
+#ifdef DEBUG
+      printf("Completion(send) value=%d tag=%d\n",
+	     *((int *)buf),rreq->tag);
+#endif
+
+      return(MPI_SUCCESS);
+    }
+
+  sreq->buf=buf;
+  sreq->tag=tag;
+  sreq->complete=0;
+  sreq->listitem=AP_list_append(mycomm->sendlist,sreq);
+
+#ifdef INFO
+  print_list(mycomm->sendlist,"sendlist for comm ",mycomm->num);
+#endif
+
+  return(MPI_SUCCESS);
+}
+
+
+/*********/
+
+
+FC_FUNC(mpi_send, MPI_SEND) ( void *buf, int *count, int *datatype,
+ 		                int *dest, int *tag, int *comm, int *ierror)
+{
+  *ierror=MPI_Send(buf, *count, *datatype, *dest, *tag, *comm);
+}
+
+
+
+int MPI_Send(void* buf, int count, MPI_Datatype datatype,
+	     int dest, int tag, MPI_Comm comm)
+{
+  MPI_Request request;
+  MPI_Status status;
+
+#ifdef INFO
+  fflush(stdout);
+  fprintf(stderr,"MPI_Send: ");
+#endif
+
+  MPI_Isend(buf,count,datatype,dest,tag,comm,&request);
+  MPI_Wait(&request,&status);
+
+
+  return(MPI_SUCCESS);
+}
+
+
+
+
+/*********/
+
+
+FC_FUNC(mpi_ssend, MPI_SSEND) ( void *buf, int *count, int *datatype,
+ 		                  int *dest, int *tag, int *comm, int *ierror)
+{
+  *ierror=MPI_Send(buf, *count, *datatype, *dest, *tag, *comm);
+}
+
+
+
+int MPI_Ssend(void* buf, int count, MPI_Datatype datatype,
+	      int dest, int tag, MPI_Comm comm)
+{
+  return(MPI_Send(buf,count,datatype,dest,tag,comm));
+}
+
+
+
+/*********/
+
+
+FC_FUNC(mpi_rsend, MPI_RSEND) ( void *buf, int *count, int *datatype,
+ 		                  int *dest, int *tag, int *comm, int *ierror)
+{
+  *ierror=MPI_Send(buf, *count, *datatype, *dest, *tag, *comm);
+}
+
+
+
+int MPI_Rsend(void* buf, int count, MPI_Datatype datatype,
+	      int dest, int tag, MPI_Comm comm)
+{
+  return(MPI_Send(buf,count,datatype,dest,tag,comm));
+}
+
+
+
+
+/*********/
+
+
+
+FC_FUNC( mpi_irsend , MPI_IRSEND )(void *buf, int *count, int *datatype,
+   int *dest, int *tag, int *comm, int *req, int *ierror)
+{
+
+  *ierror=MPI_Irsend(buf,*count,*datatype,*dest,*tag,
+		    *comm, (void *)req);
+
+}
+
+
+
+int MPI_Irsend(void *buf, int count, MPI_Datatype datatype,
+	       int dest, int tag, MPI_Comm comm, MPI_Request *request)
+{
+  MPI_Status status;
+  Req *req;
+
+
+  MPI_Isend(buf,count,datatype,dest,tag,comm,request);
+
+  /* Ready mode implied a receive must already be posted,
+   * so the Isend should have completed already.
+   * Can't use MPI_Test here for the error check because
+   * it would clear the request prematurely.
+   */
+
+  req=mpi_handle_to_ptr(*request);
+  if ( !req->complete )
+    {
+      fprintf(stderr,"MPI_Irsend: no matching receive found\n");
+      abort();
+    }
+
+
+  return(MPI_SUCCESS);
+}
+
+
+
+
+/*********/
+
+
+FC_FUNC(mpi_sendrecv, MPI_SENDRECV) (
+     void *sendbuf, int *sendcount, int *sendtype, int *dest, int *sendtag,
+     void *recvbuf, int *recvcount, int *recvtype, int *source, int *recvtag,
+     int *comm, int *status,
+     int *ierror)
+{
+  *ierror=MPI_Sendrecv(sendbuf, *sendcount, *sendtype, *dest, *sendtag,
+		       recvbuf, *recvcount, *recvtype, *source, *recvtag,
+		       *comm, (MPI_Status *)status);
+}
+
+
+
+int MPI_Sendrecv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
+		 int dest, int sendtag,
+		 void *recvbuf, int recvcount, MPI_Datatype recvtype,
+		 int source, int recvtag,
+		 MPI_Comm comm, MPI_Status *status)
+{
+  MPI_Request request;
+
+
+  MPI_Irecv(recvbuf, recvcount, recvtype, source, recvtag, comm, &request);
+
+  MPI_Send(sendbuf, sendcount, sendtype, dest, sendtag, comm);
+
+  MPI_Wait(&request,status);
+
+
+  return(MPI_SUCCESS);
+}
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/time.c
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/time.c	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpi-serial/time.c	(revision 4775)
@@ -0,0 +1,35 @@
+
+#include <sys/time.h>
+#include <time.h>
+
+
+#include "mpiP.h"
+
+
+double MPI_Wtime(void);
+
+
+
+double FC_FUNC( mpi_wtime, MPI_WTIME )(void)
+{
+  return(MPI_Wtime());
+}
+
+
+
+double MPI_Wtime(void)
+{
+  struct timeval tv;
+
+  if (gettimeofday(&tv,0))
+    {
+      fprintf(stderr,"MPI_Wtime: error calling gettimeofday()\n");
+      abort();
+    }
+
+
+  return((double)(tv.tv_sec) + (double)(tv.tv_usec)/1e6) ;
+}
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/protex/protex
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/protex/protex	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/protex/protex	(revision 4775)
@@ -0,0 +1,879 @@
+#!/usr/bin/perl
+#BOP
+#
+# !ROUTINE: ProTeX v. 2.00 - Translates DAO Prologues to LaTeX
+#
+# !INTERFACE:
+#         protex [-hbACFS] ] [+-nlsxf] [src_file(s)]
+#
+# !DESCRIPTION:
+#         Perl filter to produce a \LaTeX compatible document 
+#         from a DAO Fortran source code with standard Pro\TeX 
+#         prologues. If source files are not specified it
+#         reads from stdin; output is always to stdout.
+# 
+# \noindent        
+# {\bf Command Line Switches:} \vspace{0.2cm}
+#
+# \begin{center}
+# \begin{tabular}{|c|l|} \hline \hline
+#   -h   & Help mode: list command line options   \\ \hline
+#   -b   & Bare mode, meaning no preamble, etc.  \\ \hline
+#   +/-n & New Page for each subsection (wastes paper) \\ \hline
+#   +/-l & Listing mode, default is prologues only \\ \hline
+#   +/-s & Shut-up mode, i.e., ignore any code from BOC to EOC \\ \hline
+#   +/-x & No LaTeX mode, i.e., put !DESCRIPTION: in verbatim mode \\ \hline
+#   +/-f & No source file info \\ \hline
+#   -A   & Ada code \\ \hline
+#   -C   & C++ code \\ \hline
+#   -F   & F90 code (default) \\ \hline
+#   -S   & Shell script \\ \hline \hline
+# \end{tabular}
+# \end{center}
+#
+# The options can appear in any order.  The options, -h and -b, affect
+# the input from all files listed on command-line input.  Each of the
+# remaining options effects only the input from the files listed after
+# the option and prior to any overriding option.  The plus sign
+# turns off the option.  For example, the command-line input,
+# \bv
+#      protex -bnS File1 -F File2.f +n File3.f
+# \ev
+# will cause the option, {\tt -n} to affect the input from the files,
+# {\tt File} and {\tt File2.f}, but not from {\tt File3.f}.  The
+# {\tt -S} option is implemented for {\tt File1} but is overridden by
+# the {\tt -F} for files {\tt File2.f} and {\tt File3.f}.
+#
+#
+# !SEE ALSO:
+#         For a more detailed description of ProTeX functionality,
+#         DAO Prologue and other conventions, consult:
+#
+#           Sawyer, W., and A. da Silva, 1997: ProTeX: A Sample 
+#           Fortran 90 Source Code Documentation System.
+#           DAO Office Note 97-11
+#         
+#
+# !REVISION HISTORY:
+#
+#  20Dec1995  da Silva  First experimental version
+#  10Nov1996  da Silva  First internal release (v1.01)
+#  28Jun1997  da Silva  Modified so that !DESCRIPTION can appear after
+#             !INTERFACE, and !INPUT PARAMETERS etc. changed to italics.
+#  02Jul1997  Sawyer    Added shut-up mode
+#  20Oct1997  Sawyer    Added support for shell scripts
+#  11Mar1998  Sawyer    Added: file name, date in header, C, script support
+#  05Aug1998  Sawyer    Fixed LPChang-bug-support-for-files-with-underscores
+#  10Oct1998  da Silva  Introduced -f option for removing source file info
+#                       from subsection, etc.  Added help (WS).
+#  06Dec1999  C. Redder Added LaTeX command "\label{sec:prologues}" just 
+#                       after the beginning of the proglogue section.
+#  13Dec1999  C. Redder Increased flexbility in command-line
+#                       interface.  The options can appear in any
+#                       order which will allow the user to implement
+#                       options for select files.
+#  01Feb1999  C. Redder Added \usepackage commands to preamble of latex
+#                       document to include the packages amsmath, epsfig
+#                       and hangcaption.
+#  10May2000  C. Redder Revised LaTeX command "\label{sec:prologues}"
+#                       to "\label{app:ProLogues}"
+#  24May2001  da Silva  Added !PARAMETERS/!REURN VALUE: keywords for CAM.
+#
+#EOP
+#----------------------------------------------------------------------------
+
+# Keep this if you don't know what it does...
+# -------------------------------------------
+  $[ = 1;                 # set array base to 1
+  $, = ' ';               # set output field separator
+  $\ = "\n";              # set output record separator
+
+# Set valid options lists
+# -----------------------
+  $GlobOptions = 'hb';    # Global options (i.e for all files)
+  $LangOptions = 'ACFS';  # Options for setting programming languages
+  $SwOptions   = 'flnsx'; # Options that can change for each input 
+                          #   file
+  $RegOptions  = "$GlobOptions$LangOptions";
+                          # Scan for global options until first first
+                          #   file is processed.
+
+# Scan for global options
+# -----------------------
+  $NFiles = 0;
+Arg:
+  foreach $arg (@ARGV) {
+     $option = &CheckOpts ( $arg, $RegOptions, $SwOptions ) + 1;
+     if ( $option ) {
+        $rc = &GetOpts    ( $arg, $GlobOptions );
+         next Arg; }
+
+     else { $NFiles++;
+}#   end if
+}# end foreach
+
+# If all inut arguments are options, then assume the
+# filename, "-", for the standard input
+# --------------------------------------------------
+  if ( $NFiles == 0 ) { push (@ARGV, "-"); } 
+
+# Implement help option
+# ---------------------
+  if ( $opt_h ) {
+     &print_help();
+      exit();
+}#end if
+
+# Optional Prologue Keywords
+# --------------------------
+  @keys = ( "!INTERFACE:",
+            "!USES:",
+            "!PUBLIC TYPES:",
+            "!PUBLIC MEMBER FUNCTIONS:",
+            "!PUBLIC DATA MEMBERS:",
+            "!DEFINED PARAMETERS:",
+            "!PARAMETERS:",
+            "!INPUT PARAMETERS:",
+            "!INPUT/OUTPUT PARAMETERS:",
+            "!OUTPUT PARAMETERS:",
+            "!RETURN VALUE:",
+            "!REVISION HISTORY:",
+            "!BUGS:",
+            "!SEE ALSO:",
+            "!SYSTEM ROUTINES:",
+            "!FILES USED:",
+            "!REMARKS:",
+            "!TO DO:",
+            "!CALLING SEQUENCE:",
+            "!AUTHOR:",
+            "!CALLED FROM:",
+            "!LOCAL VARIABLES:" );
+
+# Initialize these for clarity
+# ----------------------------
+  $intro = 0;             # doing introduction?
+  $prologue = 0;          # doing prologue?
+  $first = 1;             # first prologue?
+  $source = 0;            # source code mode?
+  $verb = 0;              # verbatim mode?
+  $tpage = 0;             # title page?
+  $begdoc = 0;            # has \begin{document} been written?
+
+# Initial LaTeX stuff
+# -------------------
+  &print_notice();
+  &print_preamble();      # \documentclass, text dimensions, etc.
+  &print_macros();        # short-hand LaTeX macros
+
+# Main loop -- for each command-line argument
+# -------------------------------------------
+ARG:
+  foreach $arg (@ARGV) {
+
+#    Scan for non-global command-line options
+#    ----------------------------------------
+     $option = &CheckOpts ( $arg, $RegOptions, $SwOptions, "quiet" ) + 1;
+     if ( $option ) {
+        &GetOpts  ( $arg, $SwOptions   );
+        &SetOpt   ( $arg, $LangOptions );
+        next ARG;
+
+}#   end if
+
+#    Determine the type of code, set corresponding search strings
+#    ------------------------------------------------------------
+#    if ( $opt_F ) {            # FORTRAN
+        $comment_string = '!';  # -------
+        $boi_string = '!BOI';
+        $eoi_string = '!EOI';
+        $bop_string = '!BOP';
+        $eop_string = '!EOP';
+        $boc_string = '!BOC';
+        $eoc_string = '!EOC';
+#}#   end if
+
+     if ( $opt_A ) {            # ADA
+        $comment_string = '--'; # ---
+        $boi_string = '--BOI';
+        $eoi_string = '--EOI';
+        $bop_string = '--BOP';
+        $eop_string = '--EOP';
+        $boc_string = '--BOC';
+        $eoc_string = '--EOC';
+}#   end if
+
+     if ( $opt_C ) {
+        $comment_string = '//'; # C 
+        $boi_string = '//BOI';  # -
+        $eoi_string = '//EOI';
+        $bop_string = '//BOP';
+        $eop_string = '//EOP';
+        $boc_string = '//BOC';
+        $eoc_string = '//EOC';
+}#   end if
+
+     if ( $opt_S ) {            # Script
+        $comment_string = '#';  # ------
+        $boi_string = '#BOI';
+        $eoi_string = '#EOI';
+        $bop_string = '#BOP';
+        $eop_string = '#EOP';
+        $boc_string = '#BOC';
+        $eoc_string = '#EOC';
+}#   end if
+
+#    Set file name parameters
+#    ------------------------
+     $InputFile           = $arg;
+     @all_path_components = split( /\//, $InputFile     );
+     $FileBaseName        = pop  ( @all_path_components );
+     $FileBaseName        =~ s/_/\\_/g;
+     if ( $InputFile eq "-" ) {$FileBaseName = "Standard Input";}
+
+#    Set date
+#    --------
+     $Date                = `date`;
+
+#    Open current file
+#    -----------------
+     open ( InputFile, "$InputFile" )
+          or print STDERR "Unable to open $InputFile: $!";
+
+#    Print page header
+#    -----------------
+     printf "\n\\markboth{Left}{Source File: %s,  Date: %s}\n\n",
+                               $FileBaseName,    $Date;
+
+LINE:
+#    Inner loop --- for processing each line of the input file
+#    ---------------------------------------------------------
+     while ( <InputFile> ) {
+        chop;     # strip record separator
+        @Fld = split(' ', $_, 9999);
+
+#       Straight quote
+#       --------------
+        if ($Fld[1] eq '!QUOTE:') {
+           for ($i = 2; $i <= $#Fld; $i++) {
+               printf '%s ', $Fld[$i];
+}#         end for
+           print " ";
+           next LINE;
+}#      end if
+
+#       Handle optional Title Page and Introduction
+#       -------------------------------------------
+        if ($Fld[1] eq $boi_string) {
+           print ' ';
+           $intro = 1;
+           next LINE;
+}#      end if
+
+        if ($Fld[2] eq '!TITLE:') {
+           if ( $intro ) {
+              shift @Fld;
+              shift @Fld;
+              @title = @Fld;
+              $tpage = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+        if ($Fld[2] eq '!AUTHORS:') {
+           if ( $intro ) {
+              shift @Fld;
+              shift @Fld;
+              @author = @Fld;
+              $tpage = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+        if ($Fld[2] eq '!AFFILIATION:') {
+           if ( $intro ) {
+              shift @Fld;
+              shift @Fld;
+              @affiliation = @Fld;
+              $tpage = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+        if ($Fld[2] eq '!DATE:') {
+           if ( $intro ) {
+              shift @Fld;
+              shift @Fld;
+              @date = @Fld;
+              $tpage = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+        if ($Fld[2] eq '!INTRODUCTION:') {
+           if ( $intro ) {
+              &do_beg();
+              print ' ';
+              print '%..............................................';
+              shift @Fld;
+              shift @Fld;
+              print "\\section{@Fld}";
+              next LINE;
+}#         end if
+}#      end if
+
+
+#       End of introduction
+#       -------------------
+        if ($Fld[1] eq $eoi_string) {
+           print ' ';
+           print '%/////////////////////////////////////////////////////////////';
+           print "\\newpage";
+           $intro = 0;
+           next LINE;
+}#      end if
+
+#       Beginning of prologue
+#       ---------------------
+        if ($Fld[1] eq $bop_string) {
+           if ( $source ) { &do_eoc(); }
+           print ' ';
+           print '%/////////////////////////////////////////////////////////////';
+           &do_beg();
+           if ($first == 0) {
+              ### print "\\newpage";
+              print " ";
+              print "\\mbox{}\\hrulefill\\ ";
+              print " ";}
+           else {
+              unless($opt_b){print "\\section{Routine/Function Prologues} \\label{app:ProLogues}";}
+}#         end if
+
+           $first = 0;
+           $prologue = 1;
+           $verb = 0;
+           $source = 0;
+           &set_missing();   # no required keyword yet
+           next LINE;
+}#      end if
+
+#       A new subroutine/function
+#       -------------------------
+        if ($Fld[2] eq '!ROUTINE:' ) { 
+           if ($prologue) {
+              shift @Fld;
+              shift @Fld;
+              $_ = join(' ', @Fld);
+              $name_is = $_;
+              s/_/\\_/g;                         # Replace "_" with "\_"
+              if ( $opt_n && $not_first ) { printf "\\newpage\n"; }
+              unless ($opt_f) {printf "\\subsection{%s (Source File: %s)}\n\n", $_, $FileBaseName;}
+              else            {printf "\\subsection{%s }\n\n", $_;}
+              $have_name = 1;
+              $not_first = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+#       A new Module
+#       ------------
+        if ($Fld[2] eq '!MODULE:' ) { 
+           if ($prologue) {
+              shift @Fld;
+              shift @Fld;
+              $_ = join(' ', @Fld);
+              $name_is = $_;
+              s/_/\\_/g;                         # Replace "_" with "\_"
+              if ( $opt_n && $not_first ) { printf "\\newpage\n"; }
+              unless($opt_f) {printf "\\subsection{Module %s (Source File: %s)}\n\n", $_, $FileBaseName;}
+              else           {printf "\\subsection{Module %s }\n\n", $_;}
+              $have_name = 1;
+              $have_intf = 1;  # fake it, it does not need one.
+              $not_first = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+#       A new include file
+#       ------------------
+        if ($Fld[2] eq '!INCLUDE:' ) { 
+           if ($prologue) {
+              shift @Fld;
+              shift @Fld;
+              $_ = join(' ', @Fld);
+              $name_is = $_;
+              s/_/\\_/g;                         # Replace "_" with "\_"
+              if ( $opt_n && $not_first ) { printf "\\newpage\n"; }
+              unless($opt_f) {printf "\\subsection{Include File %s (Source File: %s)}\n\n", $_, $FileBaseName;}
+              else           {printf "\\subsection{Include File %s }\n\n", $_;}  
+              $have_name = 1;
+              $have_intf = 1;  # fake it, it does not need one.
+              $not_first = 1;
+              next LINE;
+}#         end if
+}#      end if
+ 
+#       A new INTERNAL subroutine/function
+#       ----------------------------------
+        if ($Fld[2] eq '!IROUTINE:') {            # Internal routine
+           if ($prologue) {
+              shift @Fld;
+              shift @Fld;
+              $_ = join(' ', @Fld);
+              $name_is = $_;
+              s/_/\\_/g;                        # Replace "_" with "\_"
+              printf "\\subsubsection{%s}\n\n", $_;
+              $have_name = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+#       Description: what follows will be regular LaTeX (no verbatim)
+#       -------------------------------------------------------------
+        if (/!DESCRIPTION:/) {
+           if ($prologue) {
+              if ($verb) {
+                 printf "\\end{verbatim}";
+                 printf "\n{\\sf DESCRIPTION:\\\\ }\n\n";
+                 $verb = 0; }
+              else {                          # probably never occurs
+}#            end if
+              if ($opt_x) {
+                 printf "\\begin{verbatim} ";
+                 $verb = 1;
+                 $first_verb = 1; }
+              else {
+                 for ($i = 3; $i <= $#Fld; $i++) {
+                    printf '%s ', $Fld[$i];
+}#               end for
+}#            end if
+              ### print " ";
+              $have_desc = 1;
+              next LINE;
+}#         end if
+}#      end if
+
+#       Handle optional keywords (these will appear as verbatim)
+#       --------------------------------------------------------
+        if ($prologue) {
+KEY:       foreach $key ( @keys ) {
+              if ( /$key/ ) {
+                 if ($verb) {
+                    printf "\\end{verbatim}";
+                    $verb = 0; }
+                 else {
+                    printf "\n\\bigskip";
+}#               end if
+                 $k = sprintf('%s', $key);
+                 $ln = length($k);
+                 ###printf "\\subsubsection*{%s}\n", substr($k, 2, $ln - 1);
+                 ###printf "{\\Large \\em %s}\n", ucfirst lc substr($k, 2, $ln - 1);
+                 $_ = $key;
+                 if( /USES/ || /INPUT/ || /OUTPUT/ || /PARAMETERS/ || /VALUE/ ) {
+                    printf "{\\em %s}\n", substr($k, 2, $ln - 1); } # italics
+                 else {
+                    printf "{\\sf %s}\n", substr($k, 2, $ln - 1); # san serif
+}#               end if
+
+                 printf "\\begin{verbatim} ";
+                 $verb = 1;
+                 $first_verb = 1;
+                 if ( $key eq "!INTERFACE:" )        { $have_intf = 1; }
+                 if ( $key eq "!CALLING SEQUENCE:" ) { $have_intf = 1; }
+                 if ( $key eq "!REVISION HISTORY:" ) { $have_hist = 1; }
+                 next LINE;
+}#            end if
+}#         end foreach
+}#      end if
+
+#       End of prologue
+#       ---------------
+        if ($Fld[1] eq $eop_string) {
+           if ($verb) {
+              print "\\end{verbatim}";
+              $verb = 0;
+}#         end if
+           $prologue = 0;
+           &check_if_all_there(); # check if all required keyword are there.
+           if ( $opt_l ) {
+              $Fld[1] = $boc_string;}
+           else { next LINE; }
+}#      end if
+
+        unless ( $opt_s ) {
+#
+#          Beginning of source code section
+#          --------------------------------
+           if ($Fld[1] eq $boc_string) {
+              print ' ';
+              print '%/////////////////////////////////////////////////////////////';
+              $first = 0;
+              $prologue = 0;
+              $source = 1;
+              ### printf "\\subsubsection*{CONTENTS:}\n\n", $Fld[3];
+              printf "{\\sf CONTENTS:}";
+              printf "\n \\begin{verbatim}\n";
+              $verb = 1;
+              next LINE;
+}#         end if
+
+#          End of source code
+#          ------------------
+           if ($Fld[1] eq $eoc_string) {
+              &do_eoc();
+              $prologue = 0;
+              next LINE;
+}#         end if
+}#      end unless
+   
+#   Prologue or Introduction, print regular line (except for !)
+#   -----------------------------------------------------------
+    if ($prologue||$intro) {
+        if ( $verb && $#Fld == 1 && ( $Fld[1] eq $comment_string ) ) {
+           next LINE;                # to eliminate excessive blanks 
+}#      end if
+        if ( $Fld[2] eq "\\ev" ) {   # special handling
+           $_ = $comment_string . " \\end{verbatim}";
+}#      end if
+        s/^$comment_string/ /;       # replace comment string with blank
+#       $line = sprintf('%s', $_);   # not necessary -- comment str is absent
+#       $ln = length($line);         # not necessary -- comment str is absent
+        unless ( $first_verb ) { printf "\n "; }
+        printf '%s', $_;
+#       printf '%s', substr($line, 1, $ln - 1);     # comment str is absent
+        $first_verb = 0;
+        next LINE;
+}#  end if
+
+#   Source code: print the full line
+#   --------------------------------
+    if ($source) {
+        print $_;
+        next LINE;
+}#  end if
+
+}#   end inner loop for processing each line of the input file
+ #   ---------------------------------------------------------
+
+}# end main loop for each command-line argument
+ # --------------------------------------------
+  print $_;
+  if ( $source ) { &do_eoc(); }     
+  print '%...............................................................';
+
+  unless ( $opt_b ) {
+     print "\\end{document}";
+}#end unless
+
+
+#----------------------------------------------------------------------
+
+  sub CheckOpts
+#    Checks options against a given list.  Outputs error message
+#    for any invalid option.
+#
+#    Usage:
+#       $rc = &CheckOpts ( options, valid_reg_options,
+#                                   valid_sw_options,
+#                                   quiet_mode )
+#
+#       character: options - options to be checked. (e.g. -df+x)  The
+#                            list must begin with a positive or
+#                            negative sign.  If no sign appears at the
+#                            beginning or by itself, then the argument
+#                            is not recognized as a list of options.
+#       character: valid_reg_options - list of valid regular options.
+#                            (i.e. options that are associated only
+#                            eith negative sign.)
+#       character: valid_sw_options - list of valid switch options.
+#                            (i.e. options that can be associated with
+#                            either a positive or negative sign.
+#       logical:   quiet mode (optional) If true then print no error
+#                            messages.
+#       integer:   rc      - return code
+#                            = -1 if the arguement, options, is
+#                               not recognized as a list of options
+#                            =  0 if all options are valid.
+#                            >  0 for the number of invalid options.
+# 
+{    local($options,
+           $valid_reg_options,
+           $valid_sw_options,
+           $quiet_mode ) = @_;
+
+     if ( $options eq "+" ||
+          $options eq "-" ) {return -1}
+
+     local(@Options) = split( / */, $options );
+     if ( $Options[ $[ ] ne "-" &&
+          $Options[ $[ ] ne "+" ) {return -1;}
+
+     local($option, $option_sign, $valid_list, $pos);
+     local($errs)    = 0;
+     foreach $option ( @Options ) {
+        if ( $option eq "-" ||
+             $option eq "+" ) {$option_sign = $option;}
+        else {
+           if ( $option_sign eq "-" )
+              { $valid_list = $valid_reg_options
+                            . $valid_sw_options; }
+           else
+              { $valid_list = $valid_sw_options; }
+           $pos = index ($valid_list,$option); 
+           if ( $pos < $[ &&
+                $quiet_mode ) {
+              $errs++;
+              print STDERR "Invalid option: $option_sign$option \n"; 
+
+}#         end if
+}#      end if
+}#   end foreach
+     return $errs;
+
+}#end sub GetOpts
+
+  sub GetOpts
+#    Gets options.  If an option is valid,  then opt_[option] is
+#    set to 0 or 1 as a side effect if the option is preceeded by
+#    a positive or negative sign.
+#
+#    Usage:
+#       $rc = &GetOpts ( options, valid_options )
+#
+#       character: options - options to be checked. (e.g. -df+x)  The
+#                            list must begin with a positive or
+#                            negative sign.  If no sign appears at the
+#                            beginning or by itself, then the argument
+#                            is not recognized as a list of options.
+#       character: valid_options - list of valid options (e.g. dfhx)
+#       integer:   rc      - return code
+#                            = -1 if the arguement, options, is
+#                               not recognized as a list of options.
+#                            =  0 otherwise
+# 
+{    local($options,$valid_options) = @_;
+
+     if ( $options eq "+" ||
+          $options eq "-" ) {return -1}
+
+     local(@Options)       = split( / */, $options );
+     if ( $Options[ $[ ] ne "-" &&
+          $Options[ $[ ] ne "+" ) {return -1;}
+
+     local($option, $option_sign);
+
+     foreach $option ( @Options ) {
+
+        if ( $option eq "-" ||
+             $option eq "+" ) {
+           $option_sign = $option; }
+
+        else {
+
+           if ( index ($valid_options,$option) >= $[ ) {
+              if ( $option_sign eq "-" ) {${"opt_$option"} = 1;}
+              if ( $option_sign eq "+" ) {${"opt_$option"} = 0;};
+
+}#         end if
+}#      end if
+}#   end foreach
+
+     return 0;
+}#end sub GetOpts
+
+  sub SetOpt
+#    Sets option flags.  For the last input option that is in a
+#    list, the flag opt_[option] is set to 1 as a side effect.
+#    For all other options in the list, opt_[option] is set to 0.
+#
+#    Usage:
+#       $rc = &SetOpt ( options, valid_options )
+#
+#       character: options - options to be checked. (e.g. -df+x)  The
+#                            list must begin with a positive or
+#                            negative sign.  If no sign appears at the
+#                            beginning or by itself, then the argument
+#                            is not recognized as a list of options.
+#       character: valid_options - list of valid options (e.g. def )
+#       integer:   rc      - return code
+#                            = -1 if the arguement, options, is
+#                               not recognized as a list of options.
+#                            =  0 otherwise
+#       Note: For the examples provided for the input arguments,
+#             $opt_d = 0, $opt_e = 0, and $opt_f = 1, since the 
+#             input option, -f, was the last in the argument,
+#             option.
+# 
+{    local($options,$valid_options) = @_;
+
+     if ( $options eq "+" ||
+          $options eq "-" ) {return -1}
+
+     local(@Options)       = split( / */, $options       );
+     local(@ValidOptions)  = split( / */, $valid_options );
+     if ( $Options[ $[ ] ne "-" &&
+          $Options[ $[ ] ne "+" ) {return -1;}
+
+     local($option, $option_sign);
+
+     foreach $option ( @Options ) {
+        if ( $option ne "-" &&
+             $option ne "+" ) {
+
+           if ( index ($valid_options,$option) >= $[ ) {
+              foreach $valid_option (@ValidOptions ) {
+                 ${"opt_$valid_option"} = 0;
+
+}#            end foreach
+              ${"opt_$option"} = 1;
+}#         end if
+}#      end if
+}#   end foreach
+
+  return 0;
+}#end sub SetOpt
+
+sub print_help {
+
+    print "Usage:     protex [-hbACFS] [+-nlsxf] [src_file(s)]";
+    print " ";
+    print " Options:";
+    print "     -h   Help mode: list command line options";
+    print "     -b   Bare mode, meaning no preamble, etc."; 
+    print "     +-n  New Page for each subsection (wastes paper)";
+    print "     +-l  Listing mode, default is prologues only";
+    print "     +-s  Shut-up mode, i.e., ignore any code from BOC to EOC";
+    print "     +-x  No LaTeX mode, i.e., put !DESCRIPTION: in verbatim mode";
+    print "     +-f  No source file info";
+    print "     -A   Ada code";
+    print "     -C   C++ code";
+    print "     -F   F90 code";
+    print "     -S   Shell script";
+    print " ";
+    print "  The options can appear in any order.  The options, -h and -b,";
+    print "  affect the input from all files listed on command-line input.";
+    print "  Each of the remaining options effects only the input from the";
+    print "  files listed after the option and prior to any overriding";
+    print "  option.  The plus sign turns off the option."; 
+}# end sub print_help
+
+sub print_notice {
+
+    print "%                **** IMPORTANT NOTICE *****" ;
+    print "% This LaTeX file has been automatically produced by ProTeX v. 1.1";
+    print "% Any changes made to this file will likely be lost next time";
+    print "% this file is regenerated from its source. Send questions ";
+    print "% to Arlindo da Silva, dasilva\@gsfc.nasa.gov";
+    print " ";
+
+}# sub print_notice
+
+sub print_preamble {
+
+  unless ( $opt_b ) {
+    print "%------------------------ PREAMBLE --------------------------";
+    print "\\documentclass[11pt]{article}";
+    print "\\usepackage{amsmath}";
+    print "\\usepackage{epsfig}";
+    print "\\usepackage{hangcaption}";
+    print "\\textheight     9in";
+    print "\\topmargin      0pt";
+    print "\\headsep        1cm";
+    print "\\headheight     0pt";
+    print "\\textwidth      6in";
+    print "\\oddsidemargin  0in";
+    print "\\evensidemargin 0in";
+    print "\\marginparpush  0pt";
+    print "\\pagestyle{myheadings}";
+    print "\\markboth{}{}";
+    print "%-------------------------------------------------------------";
+}#end unless
+
+    print "\\parskip        0pt";
+    print "\\parindent      0pt";
+    print "\\baselineskip  11pt";
+
+}# end sub print_preamble
+
+sub print_macros {
+
+    print " ";
+    print "%--------------------- SHORT-HAND MACROS ----------------------";
+    print "\\def\\bv{\\begin{verbatim}}";
+    print "\\def\\ev\{\\end\{verbatim}}";
+    print "\\def\\be{\\begin{equation}}";
+    print "\\def\\ee{\\end{equation}}";
+    print "\\def\\bea{\\begin{eqnarray}}";
+    print "\\def\\eea{\\end{eqnarray}}";
+    print "\\def\\bi{\\begin{itemize}}";
+    print "\\def\\ei{\\end{itemize}}";
+    print "\\def\\bn{\\begin{enumerate}}";
+    print "\\def\\en{\\end{enumerate}}";
+    print "\\def\\bd{\\begin{description}}";
+    print "\\def\\ed{\\end{description}}";
+    print "\\def\\({\\left (}";
+    print "\\def\\){\\right )}";
+    print "\\def\\[{\\left [}";
+    print "\\def\\]{\\right ]}";
+    print "\\def\\<{\\left  \\langle}";
+    print "\\def\\>{\\right \\rangle}";
+    print "\\def\\cI{{\\cal I}}";
+    print "\\def\\diag{\\mathop{\\rm diag}}";
+    print "\\def\\tr{\\mathop{\\rm tr}}";
+    print "%-------------------------------------------------------------";
+
+}# end sub print_macros
+
+sub do_beg {
+    unless ( $opt_b ) {
+    if ( $begdoc == 0 ) {
+	if ( $tpage ) {
+            print "\\title{@title}";
+            print "\\author{{\\sc @author}\\\\ {\\em @affiliation}}";
+            print "\\date{@date}";
+        }
+        print "\\begin{document}";
+        if ( $tpage ) {
+            print "\\maketitle";
+        }
+        print "\\tableofcontents";
+        print "\\newpage";
+        $begdoc = 1;
+     }
+  }
+}# end sub do_beg
+
+sub do_eoc {
+	print ' ';
+	if ($verb) {
+	    print "\\end{verbatim}";
+	    $verb = 0;
+	}
+	$source = 0;
+}# end sub do_eoc
+
+sub set_missing {
+
+  $have_name = 0;      # have routine name?
+  $have_desc = 0;      # have description?
+  $have_intf = 0;      # have interface?
+  $have_hist = 0;      # have revision history?
+  $name_is = "UNKNOWN";
+
+}# end sub set_missing
+
+    
+sub check_if_all_there {
+
+$have_name || 
+die "ProTeX: invalid prologue, missing !ROUTINE: or !IROUTINE: in <$name_is>";
+
+$have_desc || 
+die "ProTeX: invalid prologue, missing !DESCRIPTION: in <$name_is>";
+
+$have_intf || 
+die "ProTeX: invalid prologue, missing !INTERFACE: in <$name_is>";
+
+$have_hist || 
+die "ProTeX: invalid prologue, missing !REVISION HISTORY: in <$name_is>";
+
+}# end sub check_if_all_there
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/include/oasis_os.h
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/include/oasis_os.h	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/include/oasis_os.h	(revision 4775)
@@ -0,0 +1,10 @@
+
+#undef __NO_4BYTE_REALS
+
+#ifdef __SXdbl4
+#define __NO_4BYTE_REALS
+#endif
+
+#ifdef __crayx1
+#define  __NO_4BYTE_REALS
+#endif
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/Makefile	(revision 4775)
@@ -0,0 +1,84 @@
+
+SRCS1	= $(shell ls $(COUPLE)/lib/psmile/src/*.F90)
+OBJS1	= $(patsubst $(COUPLE)/lib/psmile/src/%.F90, %.o, $(SRCS1))
+
+VPATH 	= .:$(COUPLE)/lib/psmile/src:\
+	     $(COUPLE)/lib/psmile/include:\
+	     $(NETCDF_INCLUDE):$(MPI_INCLUDE)
+
+LIBRARY = $(ARCHDIR)/lib/libpsmile.${CHAN}.a
+
+clean:
+	rm -f i.* *.o *.mod
+
+all:	$(LIBRARY)
+
+$(LIBRARY): $(OBJS1) 
+	$(AR) $(ARFLAGS) $(LIBRARY) $(OBJS1) 
+
+INCLS = -I$(COUPLE)/lib/psmile/include \
+        -I$(ARCHDIR)/build/lib/mct \
+        -I$(ARCHDIR)/build/lib/scrip \
+        -I$(ARCHDIR)/build/lib/pio
+
+INCLSC = -I$(COUPLE)/lib/psmile/include
+.SUFFIXES:
+.SUFFIXES: .o .F90 .c
+
+%.o: %.F90
+	$(F90) $(F90FLAGS) $(INCLS)  -c   $<
+
+%.o: %.c
+	$(CC) $(CCFLAGS) $(INCLSC) -c   $<
+
+mod_psmile_io.o: mod_psmile_io.F90
+	$(F90) $(F90FLAGS) $(INCLS)  -c   $<
+
+#
+# ALL dependencies ...
+#
+
+mod_oasis_kinds.o: 
+mod_oasis_parameters.o: mod_oasis_kinds.o
+mod_oasis_data.o: mod_oasis_kinds.o 
+mod_oasis_sys.o: mod_oasis_kinds.o mod_oasis_data.o
+mod_oasis_mpi.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o
+mod_oasis_timer.o: mod_oasis_kinds.o mod_oasis_sys.o mod_oasis_mpi.o mod_oasis_data.o
+mod_oasis_string.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o
+mod_oasis_namcouple.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_mpi.o mod_oasis_string.o
+mod_oasis_var.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o
+mod_oasis_part.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_timer.o
+mod_oasis_ioshr.o:  mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_mpi.o mod_oasis_string.o
+mod_oasis_io.o:  mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_ioshr.o mod_oasis_mpi.o
+mod_oasis_grid.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_io.o
+mod_oasis_coupler.o: mod_oasis_kinds.o  mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_mpi.o mod_oasis_var.o mod_oasis_part.o  \
+        mod_oasis_string.o mod_oasis_namcouple.o mod_oasis_timer.o mod_oasis_io.o
+mod_oasis_advance.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_var.o mod_oasis_part.o mod_oasis_mpi.o \
+        mod_oasis_coupler.o mod_oasis_timer.o mod_oasis_io.o
+mod_oasis_method.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_coupler.o mod_oasis_namcouple.o \
+        mod_oasis_timer.o mod_oasis_ioshr.o mod_oasis_advance.o mod_oasis_grid.o \
+        mod_oasis_mpi.o
+mod_oasis_getput_interface.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_var.o mod_oasis_advance.o 
+mod_oasis_auxiliary_routines.o: mod_oasis_kinds.o mod_oasis_data.o mod_oasis_sys.o \
+        mod_oasis_parameters.o mod_oasis_var.o mod_oasis_mpi.o \
+        mod_oasis_coupler.o mod_oasis_timer.o mod_oasis_io.o
+mod_prism.o: mod_oasis_kinds.o mod_oasis_part.o mod_oasis_sys.o \
+	mod_oasis_getput_interface.o mod_oasis_parameters.o \
+	mod_oasis_grid.o mod_oasis_method.o mod_oasis_var.o \
+	mod_oasis_namcouple.o mod_oasis_auxiliary_routines.o
+mod_oasis.o: mod_oasis_kinds.o mod_oasis_part.o mod_oasis_sys.o \
+	mod_oasis_getput_interface.o mod_oasis_parameters.o \
+	mod_oasis_grid.o mod_oasis_method.o mod_oasis_var.o \
+	mod_oasis_namcouple.o mod_oasis_auxiliary_routines.o
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis.F90	(revision 4775)
@@ -0,0 +1,53 @@
+MODULE mod_oasis
+
+! !USES:
+  USE mod_oasis_kinds  ,ONLY: ip_single_p
+  USE mod_oasis_kinds  ,ONLY: ip_double_p
+  USE mod_oasis_kinds  ,ONLY: ip_realwp_p
+  USE mod_oasis_kinds  ,ONLY: ll_single
+  USE mod_oasis_kinds  ,ONLY: ip_i2_p
+  USE mod_oasis_kinds  ,ONLY: ip_i4_p
+  USE mod_oasis_kinds  ,ONLY: ip_i8_p
+  USE mod_oasis_kinds  ,ONLY: ip_intwp_p
+
+  USE mod_oasis_parameters
+
+  USE mod_oasis_namcouple ,ONLY: namflddti
+
+  USE mod_oasis_auxiliary_routines ,ONLY: oasis_get_ncpl
+  USE mod_oasis_auxiliary_routines ,ONLY: oasis_get_freqs
+  USE mod_oasis_auxiliary_routines ,ONLY: oasis_put_inquire
+
+  USE mod_oasis_method ,ONLY: oasis_init_comp    
+  USE mod_oasis_method ,ONLY: oasis_terminate
+  USE mod_oasis_method ,ONLY: oasis_get_localcomm
+  USE mod_oasis_method ,ONLY: oasis_set_couplcomm
+  USE mod_oasis_method ,ONLY: oasis_create_couplcomm
+  USE mod_oasis_method ,ONLY: oasis_get_intracomm
+  USE mod_oasis_method ,ONLY: oasis_get_intercomm 
+  USE mod_oasis_method ,ONLY: oasis_set_debug     
+  USE mod_oasis_method ,ONLY: oasis_get_debug     
+  USE mod_oasis_method ,ONLY: oasis_enddef        
+
+  USE mod_oasis_part   ,ONLY: oasis_def_partition 
+  
+  USE mod_oasis_var    ,ONLY: oasis_def_var      
+  
+  USE mod_oasis_getput_interface ,ONLY: oasis_get 
+  USE mod_oasis_getput_interface ,ONLY: oasis_put 
+  
+  USE mod_oasis_grid   ,ONLY: oasis_start_grids_writing 
+  USE mod_oasis_grid   ,ONLY: oasis_write_grid 
+  USE mod_oasis_grid   ,ONLY: oasis_write_angle
+  USE mod_oasis_grid   ,ONLY: oasis_write_corner        
+  USE mod_oasis_grid   ,ONLY: oasis_write_mask          
+  USE mod_oasis_grid   ,ONLY: oasis_write_area          
+  USE mod_oasis_grid   ,ONLY: oasis_terminate_grids_writing 
+  
+  USE mod_oasis_sys    ,ONLY: oasis_abort       
+
+  IMPLICIT NONE
+
+!===============================================================================
+
+END MODULE mod_oasis
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_advance.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_advance.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_advance.F90	(revision 4775)
@@ -0,0 +1,1920 @@
+MODULE mod_oasis_advance
+
+    USE mod_oasis_kinds
+    USE mod_oasis_data
+    USE mod_oasis_parameters
+    USE mod_oasis_namcouple, ONLY: namscrmet
+    USE mod_oasis_coupler
+    USE mod_oasis_part
+    USE mod_oasis_timer
+    USE mod_oasis_var
+    USE mod_oasis_sys
+    USE mod_oasis_io
+    USE mod_oasis_mpi
+    USE mct_mod
+
+    IMPLICIT NONE
+
+    private
+
+    public oasis_advance_init
+    public oasis_advance_run
+
+
+contains
+
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_advance_init(kinfo)
+
+!   ----------------------------------------------------------------
+!   This routine handles initial restart and communication
+!   of data for fields with positive lags
+!   ----------------------------------------------------------------
+
+    IMPLICIT none
+!   ----------------------------------------------------------------
+    INTEGER(kind=ip_i4_p), intent(inout) :: kinfo    ! status
+!   ----------------------------------------------------------------
+    integer(kind=ip_i4_p) :: cplid,partid,varid
+    INTEGER(kind=ip_i4_p) :: nf,lsize,nflds,icount
+    integer(kind=ip_i4_p) :: dt,ltime,lag,getput
+    integer(kind=ip_i4_p) :: msec
+    real   (kind=ip_r8_p), allocatable :: array(:)  ! data
+    real   (kind=ip_r8_p), allocatable :: array2(:) ! data
+    real   (kind=ip_r8_p), allocatable :: array3(:) ! data
+    real   (kind=ip_r8_p), allocatable :: array4(:) ! data
+    real   (kind=ip_r8_p), allocatable :: array5(:) ! data
+    logical               :: a2on,a3on,a4on,a5on    ! data 2-5 logicals
+    integer(kind=ip_i4_p) :: mseclag   ! model time + lag
+    character(len=ic_xl)  :: rstfile   ! restart filename
+    character(len=ic_med) :: vstring   ! temporary string
+    character(len=*),parameter :: subname = 'oasis_advance_init'
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_comm_local == MPI_COMM_NULL) then
+       write(nulprt,*) subname,' ERROR called on non coupling task'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    kinfo = OASIS_OK
+
+    call oasis_timer_start ('advance_init')
+
+    if (OASIS_debug >= 2) then
+       write(nulprt,*) '   subname         at         time    time+lag   act: field '
+       write(nulprt,*) '   diags :     fldname    min      max      sum '
+    endif
+
+    call oasis_debug_note(subname//' loop over cplid')
+    cplid=1
+    DO WHILE (cplid <= prism_ncoupler)
+      dt    = prism_coupler(cplid)%dt
+      lag   = prism_coupler(cplid)%lag
+      ltime = prism_coupler(cplid)%ltime
+      getput= prism_coupler(cplid)%getput
+      rstfile=TRIM(prism_coupler(cplid)%rstfile)
+      partid= prism_coupler(cplid)%partID
+      msec = 0   ! reasonable default to start with
+      mseclag = msec
+
+      IF (OASIS_Debug >= 2) THEN
+          WRITE(nulprt,*) '----------------------------------------------------------------'
+          WRITE(nulprt,*) subname,' Field cplid :',cplid,TRIM(prism_coupler(cplid)%fldlist)
+          WRITE(nulprt,*) subname,' lag prism_ncoupler :',lag,prism_ncoupler
+          WRITE(nulprt,*) '----------------------------------------------------------------'
+          CALL oasis_flush(nulprt)
+      ENDIF
+
+      !------------------------------------------------
+      ! check that lag is reasonable
+      !------------------------------------------------
+
+      IF (lag > dt .OR. lag <= -dt) THEN
+          WRITE(nulprt,*) subname,' ERROR lag out of dt range cplid/dt/lag=',cplid,dt,lag
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+      ENDIF
+
+      !------------------------------------------------
+      ! read restart and call advance for the current fields
+      ! right now, do not know whether any hot map terms are there
+      ! assume they are if something is read, otherwise not
+      !------------------------------------------------
+      IF ( (getput == OASIS3_PUT .AND. lag > 0) ) THEN
+          msec=0-lag
+          lsize = mct_aVect_lsize(prism_coupler(cplid)%aVect1)
+          nflds = mct_aVect_nRAttr(prism_coupler(cplid)%aVect1)
+
+          ALLOCATE(array(lsize))
+          ALLOCATE(array2(lsize))
+          ALLOCATE(array3(lsize))
+          ALLOCATE(array4(lsize))
+          ALLOCATE(array5(lsize))
+
+          DO nf = 1,nflds
+            varid = prism_coupler(cplid)%varid(nf)
+            CALL oasis_advance_run(OASIS_Out,varid,msec,kinfo,icount=icount,nff=nf,array1din=array,&
+                                 readrest=.TRUE., array2=array2,array3=array3, &
+                                 array4=array4,array5=array5)
+          ENDDO
+          cplid=cplid+icount
+
+          DEALLOCATE(array)
+          DEALLOCATE(array2)
+          DEALLOCATE(array3)
+          DEALLOCATE(array4)
+          DEALLOCATE(array5)
+      ELSE
+          cplid=cplid+1
+      ENDIF
+    ENDDO ! cplid
+    !
+    DO cplid=1, prism_ncoupler
+      dt    = prism_coupler(cplid)%dt
+      lag   = prism_coupler(cplid)%lag
+      ltime = prism_coupler(cplid)%ltime
+      getput= prism_coupler(cplid)%getput
+      rstfile=TRIM(prism_coupler(cplid)%rstfile)
+      partid= prism_coupler(cplid)%partID
+      msec = 0   ! reasonable default to start with
+      mseclag = msec
+      
+      IF (OASIS_Debug >= 2) THEN
+          WRITE(nulprt,*) '----------------------------------------------------------------'
+          WRITE(nulprt,*) subname,' Field cplid :',cplid,TRIM(prism_coupler(cplid)%fldlist)
+          WRITE(nulprt,*) '----------------------------------------------------------------'
+          CALL oasis_flush(nulprt)
+      ENDIF
+       !------------------------------------------------
+       ! read restart for LOCTRANS fields
+       ! do after restart and advance above because prism_advance_run
+       ! fills in the avect with the array info
+       !------------------------------------------------
+
+       call oasis_debug_note(subname//' check for loctrans restart')
+       IF (getput == OASIS3_PUT .AND. prism_coupler(cplid)%trans /= ip_instant) THEN
+          if (len_trim(rstfile) < 1) then
+             write(nulprt,*) subname,' ERROR restart undefined'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+          if (OASIS_debug >= 2) then
+             write(nulprt,*) subname,' at ',msec,mseclag,' RTRN: ',&
+                trim(prism_coupler(cplid)%fldlist),' ',trim(rstfile)
+          endif
+          lsize = mct_aVect_lsize(prism_coupler(cplid)%aVect1)
+
+          write(vstring,'(a,i2.2,a)') 'loc',prism_coupler(cplid)%trans,'_cnt'
+          call oasis_io_read_array(rstfile,iarray=prism_coupler(cplid)%avcnt,&
+                                   ivarname=trim(vstring),abort=.false.)
+
+          write(vstring,'(a,i2.2,a)') 'loc',prism_coupler(cplid)%trans,'_'
+          call oasis_io_read_avfile(rstfile,prism_coupler(cplid)%avect1,&
+                                    prism_part(partid)%gsmap,abort=.false.,nampre=trim(vstring))
+
+          call mct_aVect_init(prism_coupler(cplid)%aVect2,prism_coupler(cplid)%aVect1,lsize)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect2)
+          write(vstring,'(a,i2.2,a)') 'av2loc',prism_coupler(cplid)%trans,'_'
+          call oasis_io_read_avfile(rstfile,prism_coupler(cplid)%avect2,&
+                                    prism_part(partid)%gsmap,abort=.false.,nampre=trim(vstring),&
+                                    didread=prism_coupler(cplid)%aVon(2))
+          if (.not. prism_coupler(cplid)%aVon(2)) then
+             call mct_aVect_clean(prism_coupler(cplid)%avect2)
+          endif
+
+          call mct_aVect_init(prism_coupler(cplid)%aVect3,prism_coupler(cplid)%aVect1,lsize)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect3)
+          write(vstring,'(a,i2.2,a)') 'av3loc',prism_coupler(cplid)%trans,'_'
+          call oasis_io_read_avfile(rstfile,prism_coupler(cplid)%avect3,&
+                                    prism_part(partid)%gsmap,abort=.false.,nampre=trim(vstring),&
+                                    didread=prism_coupler(cplid)%aVon(3))
+          if (.not. prism_coupler(cplid)%aVon(3)) then
+             call mct_aVect_clean(prism_coupler(cplid)%avect3)
+          endif
+
+          call mct_aVect_init(prism_coupler(cplid)%aVect4,prism_coupler(cplid)%aVect1,lsize)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect4)
+          write(vstring,'(a,i2.2,a)') 'av4loc',prism_coupler(cplid)%trans,'_'
+          call oasis_io_read_avfile(rstfile,prism_coupler(cplid)%avect4,&
+                                    prism_part(partid)%gsmap,abort=.false.,nampre=trim(vstring),&
+                                    didread=prism_coupler(cplid)%aVon(4))
+          if (.not. prism_coupler(cplid)%aVon(4)) then
+             call mct_aVect_clean(prism_coupler(cplid)%avect4)
+          endif
+
+          call mct_aVect_init(prism_coupler(cplid)%aVect5,prism_coupler(cplid)%aVect1,lsize)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect5)
+          write(vstring,'(a,i2.2,a)') 'av5loc',prism_coupler(cplid)%trans,'_'
+          call oasis_io_read_avfile(rstfile,prism_coupler(cplid)%avect5,&
+                                    prism_part(partid)%gsmap,abort=.false.,nampre=trim(vstring),&
+                                    didread=prism_coupler(cplid)%aVon(5))
+          if (.not. prism_coupler(cplid)%aVon(5)) then
+             call mct_aVect_clean(prism_coupler(cplid)%avect5)
+          endif
+
+          if (OASIS_debug >= 20) then
+             write(nulprt,*) subname,'  DEBUG read loctrans restart',&
+                             cplid,prism_coupler(cplid)%avcnt
+             write(nulprt,*) subname,'  DEBUG read loctrans restart',cplid,&
+                             minval(prism_coupler(cplid)%avect1%rAttr),&
+                             maxval(prism_coupler(cplid)%avect1%rAttr)
+          endif
+       endif
+     ENDDO  ! cplid
+    call oasis_timer_stop ('advance_init')
+
+    call oasis_debug_exit(subname)
+
+  end SUBROUTINE oasis_advance_init
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_advance_run(mop,varid,msec,kinfo,icount,nff,&
+             array1din,array1dout,array2dout,readrest,&
+             a2on,array2,a3on,array3,a4on,array4,a5on,array5)
+
+    IMPLICIT none
+!   ----------------------------------------------------------------
+    integer(kind=ip_i4_p), intent(in)    :: mop      ! OASIS_Out or OASIS_In
+    INTEGER(kind=ip_i4_p), intent(in)    :: varid    ! prism_var id
+    INTEGER(kind=ip_i4_p), intent(in)    :: msec     ! model time
+    INTEGER(kind=ip_i4_p), intent(inout) :: kinfo    ! status
+    REAL   (kind=ip_r8_p), optional    :: array1din(:) ! data
+    REAL   (kind=ip_r8_p), OPTIONAL :: array1dout(:)   ! data
+    REAL   (kind=ip_r8_p), OPTIONAL :: array2dout(:,:)   ! data
+    logical              , optional    :: readrest  ! special flag to indicate this 
+                                                            ! is called from the advance_init
+    INTEGER(kind=ip_i4_p), OPTIONAL    :: nff
+    INTEGER(kind=ip_i4_p), optional   :: icount
+                                                            ! method for restart
+    logical              , optional :: a2on      ! logical for array2
+    REAL   (kind=ip_r8_p), optional :: array2(:) ! data
+    logical              , optional :: a3on      ! logical for array3
+    REAL   (kind=ip_r8_p), optional :: array3(:) ! data
+    logical              , optional :: a4on      ! logical for array4
+    REAL   (kind=ip_r8_p), optional :: array4(:) ! data
+    logical              , optional :: a5on      ! logical for array5
+    REAL   (kind=ip_r8_p), optional :: array5(:) ! data
+!   ----------------------------------------------------------------
+    character(len=ic_lvar):: vname
+    INTEGER(kind=ip_i4_p) :: cplid,rouid,mapid,partid,namID
+    INTEGER(kind=ip_i4_p) :: nfav,nsav,nsa,n,nc,nf
+    INTEGER(kind=ip_i4_p) :: lsize,nflds,iicount
+    integer(kind=ip_i4_p) :: tag,dt,ltime,lag,getput,maxtime,conserv
+    logical               :: consbfb
+    logical               :: sndrcv,output,input,unpack
+    logical               :: snddiag,rcvdiag
+    logical               :: arrayon(prism_coupler_avsmax)
+    LOGICAL               :: a22on,a33on,a44on,a55on
+    real(kind=ip_double_p):: sndmult,sndadd,rcvmult,rcvadd
+    character(len=ic_xl)  :: rstfile   ! restart filename
+    character(len=ic_xl)  :: inpfile   ! input filename
+    integer(kind=ip_i4_p) :: nx,ny
+    integer(kind=ip_i4_p) :: mseclag   ! model time + lag
+    real(kind=ip_r8_p)    :: rcnt      ! 1./cnt
+    character(len=ic_med) :: tstring   ! timer label string
+    character(len=ic_med) :: fstring   ! output file string
+    character(len=ic_med) :: cstring   ! temporary string
+    character(len=ic_med) :: vstring   ! temporary string
+    logical               :: comm_now  ! time to communicate
+    logical               :: time_now  ! coupling time
+    logical               :: lreadrest ! local readrest
+    TYPE(mct_avect)       :: avtest    ! temporary
+    type(mct_avect)       :: avtmp   ! data read from restart
+    type(mct_avect)       :: avtmp2  ! data read from restart
+    type(mct_avect)       :: avtmp3  ! data read from restart
+    type(mct_avect)       :: avtmp4  ! data read from restart
+    type(mct_avect)       :: avtmp5  ! data read from restart
+    character(len=*),parameter :: subname = 'oasis_advance_run '
+    character(len=*),parameter :: F01 = '(a,i3.3)'
+!   ----------------------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_comm_local == MPI_COMM_NULL) then
+       write(nulprt,*) subname,' ERROR called on non coupling task'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    kinfo = OASIS_OK
+    vname = prism_var(varid)%name
+
+    IF (OASIS_Debug >=15) THEN
+        WRITE(nulprt,*) subname,' Variable :',vname,' ncpl :',prism_var(varid)%ncpl
+        CALL oasis_flush(nulprt)
+    ENDIF
+
+    lreadrest = .false.
+    if (present(readrest)) then
+       lreadrest = readrest
+    endif
+    if (lreadrest) kinfo = OASIS_fromrest
+
+    !------------------------------------------------
+    ! validate mop
+    !------------------------------------------------
+
+    if (mop /= OASIS_Out .and. mop /= OASIS_In) then
+       write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+       write(nulprt,*) subname,' ERROR mop invalid ',mop
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    !------------------------------------------------
+    ! for all the couplers associated with this var
+    !------------------------------------------------
+
+    call oasis_debug_note(subname//' loop over var ncpl')
+
+    IF (PRESENT(icount)) THEN
+        icount  = 0
+    ENDIF
+    DO nc = 1,prism_var(varid)%ncpl
+      IF (PRESENT(icount)) THEN
+          icount  = icount+1
+      ENDIF
+      cplid   = prism_var(varid)%cpl(nc)
+      rouid   = prism_coupler(cplid)%routerid
+      mapid   = prism_coupler(cplid)%mapperid
+      tag     = prism_coupler(cplid)%tag
+      dt      = prism_coupler(cplid)%dt
+      lag     = prism_coupler(cplid)%lag
+      ltime   = prism_coupler(cplid)%ltime
+      getput  = prism_coupler(cplid)%getput
+      sndrcv  = prism_coupler(cplid)%sndrcv
+      rstfile =TRIM(prism_coupler(cplid)%rstfile)
+      inpfile =TRIM(prism_coupler(cplid)%inpfile)
+      maxtime = prism_coupler(cplid)%maxtime
+      output  = prism_coupler(cplid)%output
+      input   = prism_coupler(cplid)%input
+      partid  = prism_coupler(cplid)%partID
+      conserv = prism_coupler(cplid)%conserv
+      consbfb = .TRUE.
+      IF (TRIM(prism_coupler(cplid)%consopt) == "opt") consbfb = .FALSE.
+      snddiag = prism_coupler(cplid)%snddiag
+      rcvdiag = prism_coupler(cplid)%rcvdiag
+      sndadd  = prism_coupler(cplid)%sndadd
+      sndmult = prism_coupler(cplid)%sndmult
+      rcvadd  = prism_coupler(cplid)%rcvadd
+      rcvmult = prism_coupler(cplid)%rcvmult
+      namID   = prism_coupler(cplid)%namID
+      
+      unpack = (sndrcv .OR. input)
+      
+      CALL oasis_debug_note(subname//' set nx and ny')
+      IF (prism_part(partid)%nx >= 1) THEN
+          nx = prism_part(partid)%nx
+          ny = prism_part(partid)%ny
+      ELSE
+          nx = prism_part(partid)%gsize
+          ny = 1
+      ENDIF
+      
+      IF (OASIS_debug >= 20) THEN
+          WRITE(nulprt,*) subname,'  DEBUG nx, ny = ',nx,ny
+          CALL oasis_flush(nulprt)
+      ENDIF
+
+      !------------------------------------------------
+      ! check that lag is reasonable
+      !------------------------------------------------
+
+      IF (ABS(lag) > dt) THEN
+          WRITE(nulprt,*) subname,' ERROR lag gt dt for cplid',cplid
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+      ENDIF
+
+       !------------------------------------------------
+       ! read restart and call advance for the current fields
+       ! right now, do not know whether any hot map terms are there
+       ! assume they are if something is read, otherwise not
+       !------------------------------------------------
+
+       call oasis_debug_note(subname//' check for lag restart')
+       IF (getput == OASIS3_PUT .AND. lag > 0 .AND. readrest .eqv. .TRUE.) THEN
+       ! effective model time of restart : msec
+           mseclag = msec + lag
+           IF (LEN_TRIM(rstfile) < 1) THEN
+               WRITE(nulprt,*) subname,' ERROR restart undefined'
+               WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               CALL oasis_abort_noarg()
+           ENDIF
+           lsize = mct_aVect_lsize(prism_coupler(cplid)%aVect1)
+           IF (OASIS_debug >= 2) THEN
+               WRITE(nulprt,*) subname,' at ',msec,mseclag,' RRST: ',&
+                  TRIM(prism_coupler(cplid)%fldlist),' ',TRIM(rstfile)
+           ENDIF
+           CALL mct_aVect_init(avtmp,rlist=prism_coupler(cplid)%fldlist,lsize=lsize)
+           CALL oasis_io_read_avfile(TRIM(rstfile),avtmp,prism_part(partid)%gsmap)
+
+           CALL mct_aVect_init(avtmp2,rlist=prism_coupler(cplid)%fldlist,lsize=lsize)
+           CALL oasis_io_read_avfile(TRIM(rstfile),avtmp2,prism_part(partid)%gsmap, &
+                                     abort=.FALSE.,nampre='av2_',didread=a22on)
+           
+           CALL mct_aVect_init(avtmp3,rlist=prism_coupler(cplid)%fldlist,lsize=lsize)
+           CALL oasis_io_read_avfile(TRIM(rstfile),avtmp3,prism_part(partid)%gsmap, &
+                                    abort=.FALSE.,nampre='av3_',didread=a33on)
+
+           CALL mct_aVect_init(avtmp4,rlist=prism_coupler(cplid)%fldlist,lsize=lsize)
+           CALL oasis_io_read_avfile(TRIM(rstfile),avtmp4,prism_part(partid)%gsmap, &
+                                     abort=.FALSE.,nampre='av4_',didread=a44on)
+
+           CALL mct_aVect_init(avtmp5,rlist=prism_coupler(cplid)%fldlist,lsize=lsize)
+           CALL oasis_io_read_avfile(TRIM(rstfile),avtmp5,prism_part(partid)%gsmap, &
+                                    abort=.false.,nampre='av5_',didread=a55on)
+
+           array1din(1:lsize) = avtmp%rAttr(nff,1:lsize)
+           IF (a22on) array2(1:lsize) = avtmp2%rAttr(nff,1:lsize)
+           IF (a33on) array3(1:lsize) = avtmp3%rAttr(nff,1:lsize)
+           IF (a44on) array4(1:lsize) = avtmp4%rAttr(nff,1:lsize)
+           IF (a55on) array5(1:lsize) = avtmp5%rAttr(nff,1:lsize)
+
+           CALL mct_avect_clean(avtmp)
+           IF (a22on) THEN
+               CALL mct_avect_clean(avtmp2)
+           ENDIF
+           IF (a33on) THEN
+               CALL mct_avect_clean(avtmp3)
+           ENDIF
+           IF (a44on) THEN
+               CALL mct_avect_clean(avtmp4)
+           ENDIF
+           IF (a55on) THEN
+               CALL mct_avect_clean(avtmp5)
+           ENDIF
+       ENDIF
+
+
+       !------------------------------------------------
+       ! check that model op matches coupler op
+       !------------------------------------------------
+
+       if ((mop == OASIS_Out .and. getput == OASIS3_PUT) .or. &
+           (mop == OASIS_In  .and. getput == OASIS3_GET)) then
+          !-continue
+       else
+          write(nulprt,*) subname,' ERROR model op does not match coupler op',mop,getput
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       endif
+
+       !------------------------------------------------
+       ! compute lag time, only on put side
+       ! set time now, is it a coupling period?
+       !------------------------------------------------
+
+       call oasis_debug_note(subname//' set mseclag')
+       if (getput == OASIS3_PUT) then
+          mseclag = msec + lag
+       elseif (getput == OASIS3_GET) then
+          mseclag = msec
+       endif
+
+       if (OASIS_debug >= 20) then
+          write(nulprt,*) subname,'  DEBUG msec,mseclag = ',msec,mseclag
+          CALL oasis_flush(nulprt)
+       endif
+
+       time_now = .false.
+       if (mod(mseclag,dt) == 0) time_now = .true.
+
+       !------------------------------------------------
+       ! check that model hasn't gone past maxtime
+       !------------------------------------------------
+
+       if (msec >= maxtime) then
+          write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+          write(nulprt,*) subname,' ERROR model time beyond namcouple maxtime',&
+                          msec,maxtime
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       endif
+
+       !------------------------------------------------
+       ! check that model isn't going backwards
+       ! msec >= 0 does the check only in run mode, not in initialization
+       !------------------------------------------------
+
+       if (lcouplertime /= ispval .and. msec >= 0 .and. msec < lcouplertime) then
+          write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+          write(nulprt,*) subname,' ERROR model seems to be running backwards',&
+                          msec,lcouplertime
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       endif
+
+       !------------------------------------------------
+       ! check that varible didn't miss a coupling period 
+       ! also check that prior sequences weren't missed at this 
+       ! step if get operation.  only done for sndrcv operations.
+       ! attempts to trap deadlocks before they happen
+       !------------------------------------------------
+
+       do n = 1,prism_ncoupler
+          if ((prism_coupler(n)%ltime /= ispval) .and. &
+              (sndrcv .and. prism_coupler(n)%sndrcv) .and. &
+              (msec >  prism_coupler(n)%ltime + prism_coupler(n)%dt)) then
+             write(nulprt,*) subname,' ERROR coupling skipped at earlier time, &
+                             & potential deadlock '
+             write(nulprt,*) subname,' my coupler = ',cplid,' variable = ',&
+                             trim(prism_coupler(cplid)%fldlist)
+             write(nulprt,*) subname,' current time = ',msec,' mseclag = ',mseclag
+             write(nulprt,*) subname,' skipped coupler = ',n,' variable = ',&
+                             trim(prism_coupler(n)%fldlist)
+             write(nulprt,*) subname,' skipped coupler last time and dt = ',&
+                             prism_coupler(n)%ltime,prism_coupler(n)%dt
+             WRITE(nulprt,*) subname,' ERROR model timestep does not match coupling timestep'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             call oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+          if ((prism_coupler(n)%ltime /= ispval) .and. &
+              (sndrcv .and. prism_coupler(n)%sndrcv .and. getput == OASIS3_GET) .and. &
+              (prism_coupler(cplid)%seq > prism_coupler(n)%seq) .and. &
+              (msec >= prism_coupler(n)%ltime + prism_coupler(n)%dt)) then
+             write(nulprt,*) subname,' ERROR coupling sequence out of order, &
+                             & potential deadlock '
+             write(nulprt,*) subname,' my coupler = ',cplid,' variable = ',&
+                             trim(prism_coupler(cplid)%fldlist)
+             write(nulprt,*) subname,' sequence number = ',prism_coupler(cplid)%seq
+             write(nulprt,*) subname,' current time = ',msec,' mseclag = ',mseclag
+             write(nulprt,*) subname,' skipped coupler = ',n,' variable = ',&
+                             trim(prism_coupler(n)%fldlist)
+             write(nulprt,*) subname,' skipped coupler last time and dt = ',&
+                             prism_coupler(n)%ltime,prism_coupler(n)%dt
+             write(nulprt,*) subname,' skipped sequence number = ',prism_coupler(n)%seq
+             WRITE(nulprt,*) subname,' ERROR model sequence does not match coupling sequence'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+       enddo
+
+       !------------------------------------------------
+       ! compute field index and check sizes
+       !------------------------------------------------
+
+       call oasis_debug_note(subname//' compute field index and sizes')
+       nfav = mct_avect_indexra(prism_coupler(cplid)%avect1,trim(vname))
+       nsav = mct_avect_lsize(prism_coupler(cplid)%avect1)
+       if (lag > 0 .and. readrest .eqv. .true. ) nsa=size(array1din)
+       if (present(array1din )) nsa = size(array1din )
+       if (present(array1dout)) nsa = size(array1dout)
+       if (present(array2dout)) nsa = size(array2dout)
+
+       if (OASIS_debug >= 20) then
+          write(nulprt,*) subname,'  DEBUG nfav,nsav,nsa = ',nfav,nsav,nsa
+       endif
+
+       if (nsav /= nsa) then
+          write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+          write(nulprt,*) subname,' ERROR sizes ',nsav,nsa
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       endif
+
+       !------------------------------------------------
+       ! check for higher order coupling fields
+       ! and get everything ready
+       ! arrayon is what's passed this time
+       ! optional args only on put side
+       !------------------------------------------------
+
+       IF (readrest .neqv. .TRUE.) THEN
+       arrayon = .false.
+       arrayon(1) = .true.
+       if (present(a2on)) arrayon(2) = a2on
+       if (present(a3on)) arrayon(3) = a3on
+       if (present(a4on)) arrayon(4) = a4on
+       if (present(a5on)) arrayon(5) = a5on
+
+       if ((getput == OASIS3_GET) .or. &
+           (getput == OASIS3_PUT .and. trim(prism_coupler(cplid)%maploc) == "dst" )) then
+          if (arrayon(2) .or. arrayon(3) .or. &
+              arrayon(4) .or. arrayon(5)) then
+             write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+             write(nulprt,*) subname,' higher order mapping not allowed on get side'
+             write(nulprt,*) subname,' consider changing map location from dst to src'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+       endif
+
+       if ((arrayon(2) .and. .not.present(array2)) .or. &
+           (arrayon(3) .and. .not.present(array3)) .or. &
+           (arrayon(4) .and. .not.present(array4)) .or. &
+           (arrayon(5) .and. .not.present(array5))) then
+          write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+          write(nulprt,*) subname,' arrayon true but array not sent'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       ! With the current way of using oasis_advance_run, the above test is useless but we keep the test
+       ! as someone might be later adding an interface call that would violate the consistency
+       endif
+
+!      IF ( (TRIM(namscrmet(namID)) == 'BICUBIC' ) .AND. (.NOT. (arrayon(2))) &
+!         .AND. (.NOT. (arrayon(3))) .AND. (.NOT. (arrayon(4))) ) THEN
+!          WRITE(nulprt,*) subname,' ERROR : BICUBIC GRADIENT is asked ' &
+!          WRITE(nulprt,*) subname,' 2nd, 3rd and 4th arguments must be provided'
+!          CALL oasis_flush(nulprt,*)
+!          CALL oasis_abort_noarg()
+!      ENDIF
+
+       ! initialize aVect2-5 here if not already allocated
+
+       if (arrayon(2) .and. .not. prism_coupler(cplid)%aVon(2)) then
+          call mct_aVect_init(prism_coupler(cplid)%aVect2,prism_coupler(cplid)%aVect1,nsav)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect2)
+          prism_coupler(cplid)%aVon(2) = .true.
+          if (OASIS_debug >= 2) then
+             write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
+                             trim(vname),' ','aVect2'
+          endif
+       endif
+
+       if (arrayon(3) .and. .not. prism_coupler(cplid)%aVon(3)) then
+          call mct_aVect_init(prism_coupler(cplid)%aVect3,prism_coupler(cplid)%aVect1,nsav)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect3)
+          prism_coupler(cplid)%aVon(3) = .true.
+          if (OASIS_debug >= 2) then
+             write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
+                             trim(vname),' ','aVect3'
+          endif
+       endif
+
+       if (arrayon(4) .and. .not. prism_coupler(cplid)%aVon(4)) then
+          call mct_aVect_init(prism_coupler(cplid)%aVect4,prism_coupler(cplid)%aVect1,nsav)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect4)
+          prism_coupler(cplid)%aVon(4) = .true.
+          if (OASIS_debug >= 2) then
+             write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
+                             trim(vname),' ','aVect4'
+          endif
+       endif
+
+       if (arrayon(5) .and. .not. prism_coupler(cplid)%aVon(5)) then
+          call mct_aVect_init(prism_coupler(cplid)%aVect5,prism_coupler(cplid)%aVect1,nsav)
+          call mct_aVect_zero(prism_coupler(cplid)%aVect5)
+          prism_coupler(cplid)%aVon(5) = .true.
+          if (OASIS_debug >= 2) then
+             write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
+                             trim(vname),' ','aVect5'
+          endif
+       endif
+       endif
+
+       !------------------------------------------------
+       ! update avect1-5 on put side, apply appropriate transform
+       ! if its coupling time, set status of this var to ready
+       ! on restart, treat as instant value
+       !------------------------------------------------
+
+       if (getput == OASIS3_PUT) then
+
+          call oasis_debug_note(subname//' loctrans operation')
+          write(tstring,F01) 'pcpy_',cplid
+          call oasis_timer_start(tstring)
+
+          cstring = 'none'
+          if (lreadrest .or. prism_coupler(cplid)%trans == ip_instant) then
+             if (time_now) then
+                cstring = 'instant'
+                do n = 1,nsav
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) = array1din(n)
+                   if (prism_coupler(cplid)%aVon(2)) then
+                      if (present(array2)) then
+                         prism_coupler(cplid)%avect2%rAttr(nfav,n) = array2(n)
+                      else
+                         prism_coupler(cplid)%avect2%rAttr(nfav,n) = 0.0
+                      endif
+                   endif
+                   if (prism_coupler(cplid)%aVon(3)) then
+                      if (present(array3)) then
+                         prism_coupler(cplid)%avect3%rAttr(nfav,n) = array3(n)
+                      else
+                         prism_coupler(cplid)%avect3%rAttr(nfav,n) = 0.0
+                      endif
+                   endif
+                   if (prism_coupler(cplid)%aVon(4)) then
+                      if (present(array4)) then
+                         prism_coupler(cplid)%avect4%rAttr(nfav,n) = array4(n)
+                      else
+                         prism_coupler(cplid)%avect4%rAttr(nfav,n) = 0.0
+                      endif
+                   endif
+                   if (prism_coupler(cplid)%aVon(5)) then
+                      if (present(array5)) then
+                         prism_coupler(cplid)%avect5%rAttr(nfav,n) = array5(n)
+                      else
+                         prism_coupler(cplid)%avect5%rAttr(nfav,n) = 0.0
+                      endif
+                   endif
+                enddo
+                prism_coupler(cplid)%avcnt(nfav) = 1
+             endif
+
+          elseif (prism_coupler(cplid)%trans == ip_average) then
+             cstring = 'average'
+             if (kinfo == OASIS_OK) kinfo = OASIS_LocTrans
+             do n = 1,nsav
+                prism_coupler(cplid)%avect1%rAttr(nfav,n) = &
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) + array1din(n)
+                if (prism_coupler(cplid)%aVon(2)) then
+                   if (present(array2)) then
+                      prism_coupler(cplid)%avect2%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect2%rAttr(nfav,n) + array2(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(3)) then
+                   if (present(array3)) then
+                      prism_coupler(cplid)%avect3%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect3%rAttr(nfav,n) + array3(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(4)) then
+                   if (present(array4)) then
+                      prism_coupler(cplid)%avect4%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect4%rAttr(nfav,n) + array4(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(5)) then
+                   if (present(array5)) then
+                      prism_coupler(cplid)%avect5%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect5%rAttr(nfav,n) + array5(n)
+                   endif
+                endif
+             enddo
+             prism_coupler(cplid)%avcnt(nfav) = prism_coupler(cplid)%avcnt(nfav) + 1
+
+          elseif (prism_coupler(cplid)%trans == ip_accumul) then
+             cstring = 'accumul'
+             if (kinfo == OASIS_OK) kinfo = OASIS_LocTrans
+             do n = 1,nsav
+                prism_coupler(cplid)%avect1%rAttr(nfav,n) = &
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) + array1din(n)
+                if (prism_coupler(cplid)%aVon(2)) then
+                   if (present(array2)) then
+                      prism_coupler(cplid)%avect2%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect2%rAttr(nfav,n) + array2(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(3)) then
+                   if (present(array3)) then
+                      prism_coupler(cplid)%avect3%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect3%rAttr(nfav,n) + array3(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(4)) then
+                   if (present(array4)) then
+                      prism_coupler(cplid)%avect4%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect4%rAttr(nfav,n) + array4(n)
+                   endif
+                endif
+                if (prism_coupler(cplid)%aVon(5)) then
+                   if (present(array5)) then
+                      prism_coupler(cplid)%avect5%rAttr(nfav,n) = &
+                         prism_coupler(cplid)%avect5%rAttr(nfav,n) + array5(n)
+                   endif
+                endif
+             enddo
+             prism_coupler(cplid)%avcnt(nfav) = 1
+
+          elseif (prism_coupler(cplid)%trans == ip_max) then
+             cstring = 'max'
+             if (kinfo == OASIS_OK) kinfo = OASIS_LocTrans
+             if (prism_coupler(cplid)%aVon(2) .or. prism_coupler(cplid)%aVon(3) .or. &
+                 prism_coupler(cplid)%aVon(4) .or. prism_coupler(cplid)%aVon(5)) then
+                write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+                write(nulprt,*) subname,' higher order mapping with MAX trans not supported'
+                WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                CALL oasis_flush(nulprt)
+                call oasis_abort_noarg()      
+             endif
+             do n = 1,nsav
+                if (prism_coupler(cplid)%avcnt(nfav) == 0) then
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) = array1din(n)
+                else
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) = &
+                      max(prism_coupler(cplid)%avect1%rAttr(nfav,n),array1din(n))
+                endif
+             enddo
+             prism_coupler(cplid)%avcnt(nfav) = 1
+
+          elseif (prism_coupler(cplid)%trans == ip_min) then
+             cstring = 'min'
+             if (kinfo == OASIS_OK) kinfo = OASIS_LocTrans
+             if (prism_coupler(cplid)%aVon(2) .or. prism_coupler(cplid)%aVon(3) .or. &
+                 prism_coupler(cplid)%aVon(4) .or. prism_coupler(cplid)%aVon(5)) then
+                write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+                write(nulprt,*) subname,' higher order mapping with MIN trans not supported'
+                WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                CALL oasis_flush(nulprt)
+                call oasis_abort_noarg()      
+             endif
+             do n = 1,nsav
+                if (prism_coupler(cplid)%avcnt(nfav) == 0) then
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) = array1din(n)
+                else
+                   prism_coupler(cplid)%avect1%rAttr(nfav,n) = &
+                      min(prism_coupler(cplid)%avect1%rAttr(nfav,n),array1din(n))
+                endif
+             enddo
+             prism_coupler(cplid)%avcnt(nfav) = 1
+
+          else
+             write(nulprt,*) subname,' ERROR: trans not known ',prism_coupler(cplid)%trans
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+          call oasis_timer_stop(tstring)
+
+          if (OASIS_debug >= 2 .and. trim(cstring) /= 'none') then
+             write(nulprt,*) subname,' at ',msec,mseclag,' PACK: ',&
+                             trim(vname),' ',trim(cstring)
+          endif
+
+          if (OASIS_debug >= 20) then
+             write(nulprt,*) subname,'  DEBUG loctrans update ',cplid,' ',&
+             trim(cstring),prism_coupler(cplid)%avcnt(nfav)
+          endif
+
+          if (time_now) then
+             prism_coupler(cplid)%status(nfav) = OASIS_COMM_READY
+          endif
+       endif
+
+       !------------------------------------------------
+       ! decide if it's time to communicate based on 
+       ! time.  also, on the put side, status of all vars
+       ! must be ready which means all vars have called put.
+       ! on get side, all ready means all vars have unpacked
+       ! from last get.
+       !------------------------------------------------
+
+       call oasis_debug_note(subname//' comm_now compute')
+       comm_now = .false.
+       if (time_now) then
+          comm_now = .true.
+          do nf = 1,prism_coupler(cplid)%nflds
+             if (prism_coupler(cplid)%status(nf) /= OASIS_COMM_READY) then
+                comm_now = .false.
+                if (OASIS_debug >= 15) then
+                   write(nulprt,*) subname,' at ',msec,mseclag,' STAT: ',nf,' NOT READY'
+                   WRITE(nulprt,*) subname,' Status : ',prism_coupler(cplid)%status(nf)
+                endif
+                kinfo=OASIS_Waitforallingroup
+             else
+                if (OASIS_debug >= 15) then
+                   write(nulprt,*) subname,' at ',msec,mseclag,' STAT: ',nf,' READY'
+                endif
+             endif
+          enddo
+       endif
+
+       if (comm_now) then
+
+          call oasis_debug_note(subname//' comm_now')
+
+          !------------------------------------------------
+          ! this is the time critical bit, we need to make sure the
+          ! model is truly advancing in time when comms are called.
+          ! must ignore the initial call, ltime = 0
+          !------------------------------------------------
+
+          if (prism_coupler(cplid)%ltime /= ispval .and. msec <= prism_coupler(cplid)%ltime) then
+             write(nulprt,*) subname,' ERROR: model did not advance in time correctly',&
+                             msec,prism_coupler(cplid)%ltime
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+
+          !------------------------------------------------
+          ! average as needed (not cache friendly yet)
+          !------------------------------------------------
+
+          IF (getput == OASIS3_PUT) THEN
+             call oasis_debug_note(subname//' loctrans calc')
+             write(tstring,F01) 'pavg_',cplid
+             call oasis_timer_start(tstring)
+             do nf = 1,prism_coupler(cplid)%nflds
+                if (prism_coupler(cplid)%avcnt(nf) > 1) then
+                   rcnt = 1.0/prism_coupler(cplid)%avcnt(nf)
+                   do n = 1,nsav
+                      prism_coupler(cplid)%avect1%rAttr(nf,n) = &
+                         prism_coupler(cplid)%avect1%rAttr(nf,n) * rcnt
+                      if (prism_coupler(cplid)%aVon(2)) then
+                         prism_coupler(cplid)%avect2%rAttr(nf,n) = &
+                            prism_coupler(cplid)%avect2%rAttr(nf,n) * rcnt
+                      endif
+                      if (prism_coupler(cplid)%aVon(3)) then
+                         prism_coupler(cplid)%avect3%rAttr(nf,n) = &
+                            prism_coupler(cplid)%avect3%rAttr(nf,n) * rcnt
+                      endif
+                      if (prism_coupler(cplid)%aVon(4)) then
+                         prism_coupler(cplid)%avect4%rAttr(nf,n) = &
+                            prism_coupler(cplid)%avect4%rAttr(nf,n) * rcnt
+                      endif
+                      if (prism_coupler(cplid)%aVon(5)) then
+                         prism_coupler(cplid)%avect5%rAttr(nf,n) = &
+                            prism_coupler(cplid)%avect5%rAttr(nf,n) * rcnt
+                      endif
+                   enddo             
+                endif
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG loctrans calc0 = ',cplid,nf,&
+                                   prism_coupler(cplid)%avcnt(nf)
+                   write(nulprt,*) subname,'  DEBUG loctrans calc1 = ',cplid,nf,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr(nf,:)),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr(nf,:))
+                   call oasis_flush(nulprt)
+                   if (prism_coupler(cplid)%aVon(2)) &
+                   write(nulprt,*) subname,'  DEBUG loctrans calc2 = ',cplid,nf,&
+                                   minval(prism_coupler(cplid)%avect2%rAttr(nf,:)),&
+                                   maxval(prism_coupler(cplid)%avect2%rAttr(nf,:))
+                   if (prism_coupler(cplid)%aVon(3)) &
+                   write(nulprt,*) subname,'  DEBUG loctrans calc3 = ',cplid,nf,&
+                                   minval(prism_coupler(cplid)%avect3%rAttr(nf,:)),&
+                                   maxval(prism_coupler(cplid)%avect3%rAttr(nf,:))
+                   if (prism_coupler(cplid)%aVon(4)) &
+                   write(nulprt,*) subname,'  DEBUG loctrans calc4 = ',cplid,nf,&
+                                   minval(prism_coupler(cplid)%avect4%rAttr(nf,:)),&
+                                   maxval(prism_coupler(cplid)%avect4%rAttr(nf,:))
+                   if (prism_coupler(cplid)%aVon(5)) &
+                   write(nulprt,*) subname,'  DEBUG loctrans calc5 = ',cplid,nf,&
+                                   minval(prism_coupler(cplid)%avect5%rAttr(nf,:)),&
+                                   maxval(prism_coupler(cplid)%avect5%rAttr(nf,:))
+                endif
+             enddo             
+             call oasis_timer_stop(tstring)
+         ENDIF
+
+          !------------------------------------------------
+          ! past namcouple runtime (maxtime) no communication
+          ! do restart if time+lag = maxtime, this assumes coupling
+          ! period and lag and maxtime are all nicely consistent
+          !------------------------------------------------
+
+          if (mseclag >= maxtime) then
+             sndrcv = .false.   ! turn off communication
+             unpack = .false.   ! nothing to unpack
+             if (getput == OASIS3_PUT .and. lag > 0 .and. mseclag == maxtime) then
+                kinfo = OASIS_ToRest
+                call oasis_debug_note(subname//' lag restart write')
+                write(tstring,F01) 'wrst_',cplid
+                call oasis_timer_start(tstring)
+                call oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect1, &
+                   prism_part(partid)%gsmap,nx,ny)
+                if (prism_coupler(cplid)%aVon(2)) &
+                   call oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect2, &
+                      prism_part(partid)%gsmap,nx,ny,nampre='av2_')
+                if (prism_coupler(cplid)%aVon(3)) &
+                   call oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect3, &
+                      prism_part(partid)%gsmap,nx,ny,nampre='av3_')
+                if (prism_coupler(cplid)%aVon(4)) &
+                   call oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect4, &
+                      prism_part(partid)%gsmap,nx,ny,nampre='av4_')
+                if (prism_coupler(cplid)%aVon(5)) &
+                   call oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect5, &
+                      prism_part(partid)%gsmap,nx,ny,nampre='av5_')
+                call oasis_timer_stop(tstring)
+                if (OASIS_debug >= 2) then
+                   write(nulprt,*) subname,' at ',msec,mseclag,' WRST: ', &
+                      trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1)),' ',&
+                      trim(rstfile)
+                   call oasis_flush(nulprt)
+                endif
+             endif
+          endif
+
+          !------------------------------------------------
+          ! map and communicate operations
+          !------------------------------------------------
+
+          if (sndrcv) then
+          if (getput == OASIS3_PUT) then
+             kinfo = OASIS_sent
+             call oasis_debug_note(subname//' put section')
+             if (OASIS_debug >= 2) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' SEND: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+                call oasis_flush(nulprt)
+             endif
+             if (sndadd /= 0.0_ip_double_p .or. sndmult /= 1.0_ip_double_p) then
+                call oasis_debug_note(subname//' apply sndmult sndadd')
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG sndmult,add = ',sndmult,sndadd
+                   write(nulprt,*) subname,'  DEBUG put b4 sndmult,add = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                endif
+                prism_coupler(cplid)%avect1%rAttr(:,:) = prism_coupler(cplid)%avect1%rAttr(:,:)*sndmult &
+                                                         + sndadd
+             endif
+             if (snddiag) call oasis_advance_avdiag(prism_coupler(cplid)%avect1,mpi_comm_local)
+             if (mapid > 0) then
+                write(tstring,F01) 'pmap_',cplid
+                call oasis_debug_note(subname//' put map')
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG put av11 b4 map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                   if (prism_coupler(cplid)%aVon(2)) &
+                   write(nulprt,*) subname,'  DEBUG put av2 b4 map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect2%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect2%rAttr)
+                   if (prism_coupler(cplid)%aVon(3)) &
+                   write(nulprt,*) subname,'  DEBUG put av3 b4 map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect3%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect3%rAttr)
+                   if (prism_coupler(cplid)%aVon(4)) &
+                   write(nulprt,*) subname,'  DEBUG put av4 b4 map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect4%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect4%rAttr)
+                   if (prism_coupler(cplid)%aVon(5)) &
+                   write(nulprt,*) subname,'  DEBUG put av5 b4 map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect5%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect5%rAttr)
+                endif
+                call oasis_timer_start(tstring)
+                call mct_avect_zero(prism_coupler(cplid)%avect1m)
+                call oasis_advance_map(prism_coupler(cplid)%avect1, &
+                     prism_coupler(cplid)%avect1m,prism_mapper(mapid),conserv,consbfb, &
+                     prism_coupler(cplid)%aVon  ,prism_coupler(cplid)%avect2, &
+                     prism_coupler(cplid)%avect3,prism_coupler(cplid)%avect4, &
+                     prism_coupler(cplid)%avect5)
+                call oasis_timer_stop(tstring)
+                write(tstring,F01) 'psnd_',cplid
+                call oasis_debug_note(subname//' put send')
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG put av1m b4 send = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1m%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1m%rAttr)
+                endif
+                call oasis_timer_start(tstring)
+                call mct_waitsend(prism_router(rouid)%router)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' Before MPI put ', MPI_Wtime()
+#endif
+                call mct_isend(prism_coupler(cplid)%avect1m,prism_router(rouid)%router,tag)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' After MPI put ', MPI_Wtime()
+#endif
+                call oasis_timer_stop(tstring)
+            ELSE
+                write(tstring,F01) 'psnd_',cplid
+                call oasis_debug_note(subname//' put send')
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG put av1 b4 send = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                endif
+                call oasis_timer_start(tstring)
+                call mct_waitsend(prism_router(rouid)%router)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' Before MPI put ', MPI_Wtime()
+#endif
+                call mct_isend(prism_coupler(cplid)%avect1,prism_router(rouid)%router,tag)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' After MPI put ', MPI_Wtime()
+#endif
+                call oasis_timer_stop(tstring)
+             endif
+          elseif (getput == OASIS3_GET) then
+             call oasis_debug_note(subname//' get section')
+             if (OASIS_debug >= 2 ) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' RECV: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+                call oasis_flush(nulprt)
+             endif
+             if (mapid > 0) then
+                call oasis_debug_note(subname//' get recv')
+                write(tstring,F01) 'grcv_',cplid
+                call oasis_timer_start(tstring)
+                call mct_avect_zero(prism_coupler(cplid)%avect1m)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' Before MPI get ', MPI_Wtime()
+#endif
+                call mct_recv(prism_coupler(cplid)%avect1m,prism_router(rouid)%router,tag)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' After MPI get ', MPI_Wtime()
+#endif
+                call oasis_timer_stop(tstring)
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG get af recv = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1m%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1m%rAttr)
+                endif
+                call oasis_debug_note(subname//' get map')
+                write(tstring,F01) 'gmap_',cplid
+                call oasis_timer_start(tstring)
+                call mct_avect_zero(prism_coupler(cplid)%avect1)
+                call oasis_advance_map(prism_coupler(cplid)%avect1m, &
+                     prism_coupler(cplid)%avect1,prism_mapper(mapid),conserv,consbfb)
+                call oasis_timer_stop(tstring)
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG get af map = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                endif
+             else
+                write(tstring,F01) 'grcv_',cplid
+                call oasis_debug_note(subname//' get recv')
+                call oasis_timer_start(tstring)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' Before MPI get ', MPI_Wtime()
+#endif
+                call mct_recv(prism_coupler(cplid)%avect1,prism_router(rouid)%router,tag)
+#if defined balance
+                WRITE(nulprt, FMT='(A,I2.2,A,F16.5)') &
+                              'Balance: ',cplid,' After MPI get ', MPI_Wtime()
+#endif
+                call oasis_timer_stop(tstring)
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG get af recv = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                endif
+             endif
+             call oasis_debug_note(subname//' apply rcvmult rcvadd')
+             if (rcvadd /= 0.0_ip_double_p .or. rcvmult /= 1.0_ip_double_p) then
+                prism_coupler(cplid)%avect1%rAttr(:,:) = prism_coupler(cplid)%avect1%rAttr(:,:)*rcvmult &
+                                                         + rcvadd
+                if (OASIS_debug >= 20) then
+                   write(nulprt,*) subname,'  DEBUG rcvmult,add = ',rcvmult,rcvadd
+                   write(nulprt,*) subname,'  DEBUG get af rcvmult,add = ',cplid,&
+                                   minval(prism_coupler(cplid)%avect1%rAttr),&
+                                   maxval(prism_coupler(cplid)%avect1%rAttr)
+                endif
+             endif
+             if (rcvdiag) call oasis_advance_avdiag(prism_coupler(cplid)%avect1,mpi_comm_local)
+          endif  ! getput
+          endif  ! sndrcv
+
+          if (output) then
+             if (kinfo == OASIS_sent) then
+                kinfo = OASIS_sentout
+             elseif (kinfo == OASIS_torest) then
+                kinfo = OASIS_torestout
+             else
+                kinfo = OASIS_output
+             endif
+             call oasis_debug_note(subname//' output')
+             write(tstring,F01) 'wout_',cplid
+             call oasis_timer_start(tstring)
+             if (OASIS_debug >= 2) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' WRIT: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+                call oasis_flush(nulprt)
+             endif
+             write(fstring,'(A,I2.2)') '_'//trim(compnm)//'_',cplid
+             call oasis_io_write_avfbf(prism_coupler(cplid)%avect1,prism_part(partid)%gsmap, &
+                nx,ny,msec,fstring)
+             call oasis_timer_stop(tstring)
+
+             if (OASIS_debug >= 30) then
+                call mct_avect_init(avtest,prism_coupler(cplid)%avect1,&
+                                    mct_aVect_lsize(prism_coupler(cplid)%avect1))
+                write(tstring,F01) 'rinp_',cplid
+                call oasis_timer_start(tstring)
+                call oasis_io_read_avfbf(avtest,prism_part(partid)%gsmap,msec,fstring)
+                write(nulprt,*) subname,' DEBUG write/read test avfbf should be zero ',&
+                                sum(prism_coupler(cplid)%avect1%rAttr-avtest%rAttr)
+                call mct_avect_clean(avtest)
+                call oasis_timer_stop(tstring)
+             endif
+
+          endif
+
+          !------------------------------------------------
+          ! set avcnt, avect1, ltime, and status
+          !------------------------------------------------
+
+          call oasis_debug_note(subname//' reset status')
+          if (getput == OASIS3_PUT) then
+             prism_coupler(cplid)%ltime = msec
+             prism_coupler(cplid)%status(:) = OASIS_COMM_WAIT
+             prism_coupler(cplid)%avcnt(:) = 0
+             call mct_avect_zero(prism_coupler(cplid)%avect1)
+             if (prism_coupler(cplid)%aVon(2)) &
+                call mct_avect_zero(prism_coupler(cplid)%avect2)
+             if (prism_coupler(cplid)%aVon(3)) &
+                call mct_avect_zero(prism_coupler(cplid)%avect3)
+             if (prism_coupler(cplid)%aVon(4)) &
+                call mct_avect_zero(prism_coupler(cplid)%avect4)
+             if (prism_coupler(cplid)%aVon(5)) &
+                call mct_avect_zero(prism_coupler(cplid)%avect5)
+             if (OASIS_debug >= 20) then
+                write(nulprt,*) subname,'  DEBUG put reset status = '
+             endif
+          elseif (getput == OASIS3_GET) then
+             prism_coupler(cplid)%ltime = msec
+             prism_coupler(cplid)%status(:) = OASIS_COMM_WAIT
+             if (OASIS_debug >= 20) then
+                write(nulprt,*) subname,'  DEBUG get reset status = '
+             endif
+          endif
+
+      ELSE
+
+          !------------------------------------------------
+          ! no action, document
+          !------------------------------------------------
+
+          if (OASIS_debug >= 15) then
+             if (getput == OASIS3_PUT) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' SKIP: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+             elseif (getput == OASIS3_GET) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' SKIP: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+             endif
+             call oasis_flush(nulprt)
+          endif
+
+       endif   ! comm_now
+
+          !------------------------------------------------
+          ! sav non-instant loctrans operations for future restart
+          !   at the end of the run only
+          !------------------------------------------------
+
+          IF (mseclag + dt >= maxtime .AND. &
+             getput == OASIS3_PUT .and. prism_coupler(cplid)%trans /= ip_instant) then
+             call oasis_debug_note(subname//' loctrans restart write')
+             write(tstring,F01) 'wtrn_',cplid
+             call oasis_timer_start(tstring)
+             WRITE(vstring,'(a,i2.2,a)') 'loc',prism_coupler(cplid)%trans,'_cnt'
+             CALL oasis_io_write_array(rstfile,iarray=prism_coupler(cplid)%avcnt,&
+                                       ivarname=TRIM(vstring))
+             write(vstring,'(a,i2.2,a)') 'loc',prism_coupler(cplid)%trans,'_'
+             CALL oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect1, &
+                prism_part(partid)%gsmap,nx,ny,nampre=TRIM(vstring))
+             if (prism_coupler(cplid)%aVon(2)) then
+                write(vstring,'(a,i2.2,a)') 'av2loc',prism_coupler(cplid)%trans,'_'
+                CALL oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect2, &
+                   prism_part(partid)%gsmap,nx,ny,nampre=TRIM(vstring))
+             endif
+             if (prism_coupler(cplid)%aVon(3)) then
+                write(vstring,'(a,i2.2,a)') 'av3loc',prism_coupler(cplid)%trans,'_'
+                CALL oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect3, &
+                   prism_part(partid)%gsmap,nx,ny,nampre=TRIM(vstring))
+             endif
+             if (prism_coupler(cplid)%aVon(4)) then
+                write(vstring,'(a,i2.2,a)') 'av4loc',prism_coupler(cplid)%trans,'_'
+                CALL oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect4, &
+                   prism_part(partid)%gsmap,nx,ny,nampre=TRIM(vstring))
+             endif
+             if (prism_coupler(cplid)%aVon(5)) then
+                write(vstring,'(a,i2.2,a)') 'av5loc',prism_coupler(cplid)%trans,'_'
+                CALL oasis_io_write_avfile(rstfile,prism_coupler(cplid)%avect5, &
+                   prism_part(partid)%gsmap,nx,ny,nampre=TRIM(vstring))
+             endif
+             call oasis_timer_stop(tstring)
+             if (OASIS_debug >= 2) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' WTRN: ', &
+                   trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1)),' ',trim(rstfile)
+                call oasis_flush(nulprt)
+             endif
+             if (OASIS_debug >= 20) then
+                write(nulprt,*) subname,'  DEBUG write loctrans restart',cplid,&
+                                prism_coupler(cplid)%avcnt
+                write(nulprt,*) subname,'  DEBUG write loctrans restart',cplid,&
+                                minval(prism_coupler(cplid)%avect1%rAttr),&
+                                maxval(prism_coupler(cplid)%avect1%rAttr)
+             endif
+         ENDIF
+
+       !------------------------------------------------
+       ! GET only, unpack avect1 if its coupling time
+       !------------------------------------------------
+
+       IF (getput == OASIS3_GET) THEN
+         IF (time_now .AND. unpack) THEN
+             if (kinfo == OASIS_output) then
+                kinfo = OASIS_recvout
+             elseif (kinfo == OASIS_fromrest) then
+                kinfo = OASIS_fromrestout
+             else
+                kinfo = OASIS_recvd
+             endif
+             if (input) then
+                kinfo = OASIS_input
+                call oasis_debug_note(subname//' input')
+                if (OASIS_debug >= 2) then
+                   write(nulprt,*) subname,' at ',msec,mseclag,' READ: ', &
+                      trim(mct_avect_exportRList2c(prism_coupler(cplid)%avect1))
+                   call oasis_flush(nulprt)
+                endif
+                write(tstring,F01) 'grin_',cplid
+                call oasis_timer_start(tstring)
+                if (trim(inpfile) /= trim(cspval)) then
+                   call oasis_io_read_avfbf(prism_coupler(cplid)%avect1,prism_part(partid)%gsmap,&
+                                            msec,filename=trim(inpfile))
+                else
+                   fstring = '_'//trim(compnm)
+                   call oasis_io_read_avfbf(prism_coupler(cplid)%avect1,prism_part(partid)%gsmap,&
+                                            msec,f_string=fstring)
+                endif
+                call oasis_timer_stop(tstring)
+             endif
+             if (OASIS_debug >= 2) then
+                write(nulprt,*) subname,' at ',msec,mseclag,' UPCK: ',trim(vname)
+             endif
+             write(tstring,F01) 'gcpy_',cplid
+             call oasis_debug_note(subname//' get copy to array')
+             call oasis_timer_start(tstring)
+             if (present(array1dout)) array1dout(:) = &
+                       prism_coupler(cplid)%avect1%rAttr(nfav,:)
+             if (present(array2dout)) array2dout(:,:) = &
+                      RESHAPE(prism_coupler(cplid)%avect1%rAttr(nfav,:),SHAPE(array2dout))
+             call oasis_timer_stop(tstring)
+             if (OASIS_debug >= 20) then
+                if (present(array1dout)) write(nulprt,*) subname,'  DEBUG array copy = ',&
+                         cplid,minval(array1dout),maxval(array1dout)
+                if (present(array2dout)) write(nulprt,*) subname,'  DEBUG array copy = ',&
+                         cplid,minval(array2dout),maxval(array2dout)
+             endif
+         ENDIF
+          if (time_now) prism_coupler(cplid)%status(nfav) = OASIS_COMM_READY
+      ENDIF
+
+       !------------------------------------------------
+       ! always remember last id and last coupler time
+       !------------------------------------------------
+
+       lcouplerid = cplid
+       lcouplertime = msec
+
+       if (OASIS_debug >= 2) then
+          write(nulprt,*) subname,' at ',msec,mseclag,' KINF: ',trim(vname),kinfo
+       endif
+
+    enddo  ! nc = 1,var%ncpl
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_advance_run
+
+
+!-------------------------------------------------------------------
+
+  SUBROUTINE oasis_advance_map(av1,avd,mapper,conserv,consbfb,&
+                               avon,av2,av3,av4,av5)
+
+    ! NOTE: mask = 0 is active point according to oasis3 conserv.f
+
+    implicit none
+    type(mct_aVect)        ,intent(in)    :: av1  ! source av
+    type(mct_aVect)        ,intent(inout) :: avd    ! dst av
+    type(prism_mapper_type),intent(inout) :: mapper ! prism_mapper
+    integer(kind=ip_i4_p)  ,intent(in),optional :: conserv  ! conserv flag
+    logical                ,intent(in),optional :: consbfb  ! conserv bfb option
+    logical                ,intent(in),optional :: avon(:) ! which source avs are on
+    type(mct_aVect)        ,intent(in),optional :: av2  ! source av2
+    type(mct_aVect)        ,intent(in),optional :: av3  ! source av2
+    type(mct_aVect)        ,intent(in),optional :: av4  ! source av2
+    type(mct_aVect)        ,intent(in),optional :: av5  ! source av2
+
+    integer(kind=ip_i4_p)  :: fsize,lsizes,lsized,nf,ni,n,m
+    real(kind=ip_r8_p)     :: sumtmp, wts_sums, wts_sumd, zradi, zlagr
+    integer(kind=ip_i4_p),allocatable :: imasks(:),imaskd(:)
+    real(kind=ip_r8_p),allocatable :: areas(:),aread(:)
+    real(kind=ip_r8_p),allocatable  :: av_sums(:),av_sumd(:)  ! local sums
+    character(len=ic_med) :: tstring   ! timer label string
+    type(mct_aVect)       :: avdtmp    ! for summing multiple mapping weights
+    type(mct_aVect)       :: av2g      ! for bfb sums
+    logical               :: lconsbfb
+    integer(kind=ip_i4_p),parameter :: avsmax = prism_coupler_avsmax
+    logical               :: locavon(avsmax)   ! local avon
+    integer(kind=ip_i4_p) :: avonsize, nterm
+    character(len=*),parameter :: subname = 'oasis_advance_map'
+
+    call oasis_debug_enter(subname)
+
+    lconsbfb = .true.
+    if (present(consbfb)) then
+       lconsbfb = consbfb
+    endif
+
+    !--- assume avon and av2-5 are not passed but av1 always is ---
+    avonsize = 1
+    nterm = 1
+    locavon = .false.
+    locavon(1) = .true.
+
+    !--- but if avon is passed, use avon flags ---
+    if (present(avon)) then
+       avonsize = size(avon)
+       nterm = min(avsmax,avonsize)
+       locavon(1:nterm) = avon(1:nterm)
+    else
+       !--- if avon is not passed, av2-5 should not be ---
+       if (present(av2) .or. present(av3) .or. present(av4) .or. present(av5)) then
+          WRITE(nulprt,*) subname,' ERROR av2-5 passed but avon not passed'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    ! check consistency between weights and coupling terms
+    do n = 1,nterm
+       if (locavon(n) .and. n > mapper%nwgts) then
+          WRITE(nulprt,*) subname,' ERROR in nwgts and coupling terms',mapper%nwgts,n
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    enddo
+
+
+    if (locavon(1)) then
+       if (mct_avect_nRattr(av1) /= mct_avect_nRattr(avd)) then
+          WRITE(nulprt,*) subname,' ERROR in av1 num of flds'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+       call mct_sMat_avMult(av1, mapper%sMatP(1), avd)
+    endif
+
+    if (locavon(2).or.locavon(3).or.locavon(4).or.locavon(5)) then
+       lsized = mct_avect_lsize(avd)
+       call mct_aVect_init(avdtmp,avd,lsized)
+
+       if (locavon(2)) then
+          if (mct_avect_nRattr(av2) /= mct_avect_nRattr(avd)) then
+             WRITE(nulprt,*) subname,' ERROR in av2 num of flds'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+          endif
+          call mct_sMat_avMult(av2, mapper%sMatP(2), avdtmp)
+          avd%rAttr = avd%rAttr + avdtmp%rAttr
+       endif
+
+       if (locavon(3)) then
+          if (mct_avect_nRattr(av3) /= mct_avect_nRattr(avd)) then
+             WRITE(nulprt,*) subname,' ERROR in av3 num of flds'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+          endif
+          call mct_sMat_avMult(av3, mapper%sMatP(3), avdtmp)
+          avd%rAttr = avd%rAttr + avdtmp%rAttr
+       endif
+
+       if (locavon(4)) then
+          if (mct_avect_nRattr(av4) /= mct_avect_nRattr(avd)) then
+             WRITE(nulprt,*) subname,' ERROR in av4 num of flds'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+          endif
+          call mct_sMat_avMult(av4, mapper%sMatP(4), avdtmp)
+          avd%rAttr = avd%rAttr + avdtmp%rAttr
+       endif
+
+       if (locavon(5)) then
+          if (mct_avect_nRattr(av5) /= mct_avect_nRattr(avd)) then
+             WRITE(nulprt,*) subname,' ERROR in av5 num of flds'
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+          endif
+          call mct_sMat_avMult(av5, mapper%sMatP(5), avdtmp)
+          avd%rAttr = avd%rAttr + avdtmp%rAttr
+       endif
+
+       call mct_aVect_clean(avdtmp)
+    endif
+
+
+    call oasis_debug_note(subname//' map')
+
+    IF (PRESENT(conserv)) THEN
+    call oasis_debug_note(subname//' conserv')
+    IF (conserv /= ip_cnone) THEN
+       fsize = mct_avect_nRattr(av1)
+       allocate(av_sums(fsize),av_sumd(fsize))
+
+       zradi = 1./(eradius*eradius)
+
+       !-------------------
+       ! extract mask and area and compute sum of masked area for source
+       !-------------------
+       lsizes = mct_avect_lsize(mapper%av_ms)
+       allocate(imasks(lsizes),areas(lsizes))
+       nf = mct_aVect_indexIA(mapper%av_ms,'mask')
+       imasks(:) = mapper%av_ms%iAttr(nf,:)
+       nf = mct_aVect_indexRA(mapper%av_ms,'area')
+       areas(:) = mapper%av_ms%rAttr(nf,:)*zradi
+
+       if (lconsbfb) then
+          call mct_avect_gather(mapper%av_ms,av2g,prism_part(mapper%spart)%gsmap,&
+                                0,mpi_comm_local)
+          wts_sums = 0.0_ip_r8_p
+          if (mpi_rank_local == 0) then
+             ni = mct_aVect_indexIA(av2g,'mask')
+             nf = mct_aVect_indexRA(av2g,'area')
+             do n = 1,mct_avect_lsize(av2g)
+                if (av2g%iAttr(ni,n) == 0) wts_sums = wts_sums + av2g%rAttr(nf,n)*zradi
+             enddo
+          endif
+          call oasis_mpi_bcast(wts_sums,mpi_comm_local,subname//" bcast wts_sums")
+       if (mpi_rank_local == 0) then 
+          call mct_avect_clean(av2g)
+       endif 
+       else
+          sumtmp = 0.0_ip_r8_p
+          do n = 1,lsizes
+             if (imasks(n) == 0) sumtmp = sumtmp + areas(n)
+          enddo
+          call oasis_mpi_sum(sumtmp,wts_sums,mpi_comm_local,string=subname//':wts_sums',&
+                             all=.true.)
+       endif
+
+       !-------------------
+       ! extract mask and area and compute sum of masked area for destination
+       !-------------------
+       lsized = mct_avect_lsize(mapper%av_md)
+       allocate(imaskd(lsized),aread(lsized))
+       nf = mct_aVect_indexIA(mapper%av_md,'mask')
+       imaskd(:) = mapper%av_md%iAttr(nf,:)
+       nf = mct_aVect_indexRA(mapper%av_md,'area')
+       aread(:) = mapper%av_md%rAttr(nf,:)*zradi
+
+       if (lconsbfb) then
+          call mct_avect_gather(mapper%av_md,av2g,prism_part(mapper%dpart)%gsmap,0,mpi_comm_local)
+          wts_sumd = 0.0_ip_r8_p
+          if (mpi_rank_local == 0) then
+             ni = mct_aVect_indexIA(av2g,'mask')
+             nf = mct_aVect_indexRA(av2g,'area')
+             do n = 1,mct_avect_lsize(av2g)
+                if (av2g%iAttr(ni,n) == 0) wts_sumd = wts_sumd + av2g%rAttr(nf,n)*zradi
+             enddo
+          endif
+          call oasis_mpi_bcast(wts_sumd,mpi_comm_local,subname//" bcast wts_sumd")
+       if (mpi_rank_local == 0) then
+          call mct_avect_clean(av2g)
+       endif
+       else
+          sumtmp = 0.0_ip_r8_p
+          do n = 1,lsized
+             if (imaskd(n) == 0) sumtmp = sumtmp + aread(n)
+          enddo
+          call oasis_mpi_sum(sumtmp,wts_sumd,mpi_comm_local,string=subname//':wts_sumd',all=.true.)
+       endif
+
+       if (OASIS_debug >= 30) then
+          write(nulprt,*) subname,' DEBUG conserve src mask ',minval(imasks),&
+                          maxval(imasks),sum(imasks)
+          write(nulprt,*) subname,' DEBUG conserve dst mask ',minval(imaskd),&
+                          maxval(imaskd),sum(imaskd)
+          write(nulprt,*) subname,' DEBUG conserve src area ',minval(areas),&
+                          maxval(areas),sum(areas)
+          write(nulprt,*) subname,' DEBUG conserve dst area ',minval(aread),&
+                          maxval(aread),sum(aread)
+          write(nulprt,*) subname,' DEBUG conserve wts_sum  ',wts_sums,wts_sumd
+       endif
+
+       !-------------------
+       ! compute global sums of av1
+       ! assume av1 is the thing to be conserved
+       !-------------------
+       call oasis_advance_avsum(av1,av_sums,prism_part(mapper%spart)%gsmap,mpi_comm_local, &
+                                mask=imasks,wts=areas,consbfb=lconsbfb)
+       call oasis_advance_avsum(avd,av_sumd,prism_part(mapper%dpart)%gsmap,mpi_comm_local, &
+                                mask=imaskd,wts=aread,consbfb=lconsbfb)
+
+       if (OASIS_debug >= 20) then
+          write(nulprt,*) subname,' DEBUG src sum b4 conserve ',av_sums
+          write(nulprt,*) subname,' DEBUG dst sum b4 conserve ',av_sumd
+       endif
+
+       if (conserv == ip_cglobal) then
+          if (wts_sumd == 0.0_ip_r8_p) then
+              WRITE(nulprt,*) subname,' ERROR: conserve global wts_sumd/sums zero'
+              WRITE(nulprt,*) subname,' abort by model :',compid,&
+                              ' proc :',mpi_rank_local
+              CALL oasis_flush(nulprt)
+              CALL oasis_abort_noarg()
+          endif
+          do m = 1,fsize
+             zlagr = (av_sumd(m) - av_sums(m)) / wts_sumd
+             do n = 1,lsized
+                if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) - zlagr
+             enddo
+          enddo
+       elseif (conserv == ip_cglbpos) then
+          do m = 1,fsize
+             if (av_sumd(m) == 0.0_ip_r8_p .and. av_sums(m) /= 0.0_ip_r8_p) then
+                 WRITE(nulprt,*) subname,' ERROR: conserve cglbpos av_sumd/sums'
+                 WRITE(nulprt,*) subname,' abort by model :',compid,&
+                                 ' proc :',mpi_rank_local
+                 CALL oasis_flush(nulprt)
+                 CALL oasis_abort_noarg()
+             elseif (av_sumd(m) /= 0.0_ip_r8_p) then
+                zlagr = av_sums(m) / av_sumd(m)
+                do n = 1,lsized
+                   if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) * zlagr
+                enddo
+             endif
+          enddo
+       elseif (conserv == ip_cbasbal) then
+          if (wts_sumd == 0.0_ip_r8_p .or. wts_sums == 0.0_ip_r8_p) then
+              WRITE(nulprt,*) subname,' ERROR: conserve wts_sumd/sums zero'
+              WRITE(nulprt,*) subname,' abort by model :',compid,&
+                              ' proc :',mpi_rank_local
+              CALL oasis_flush(nulprt)
+              CALL oasis_abort_noarg()
+          endif
+          do m = 1,fsize
+             zlagr = (av_sumd(m) - (av_sums(m)*(wts_sumd/wts_sums))) / wts_sumd
+             do n = 1,lsized
+                if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) - zlagr
+             enddo
+          enddo
+       elseif (conserv == ip_cbaspos) then
+          do m = 1,fsize
+             if (av_sumd(m) == 0.0_ip_r8_p .and. av_sums(m) /= 0.0_ip_r8_p) then
+                 WRITE(nulprt,*) subname,' ERROR: conserve cglbpos av_sumd/sums'
+                 WRITE(nulprt,*) subname,' abort by model :',compid,&
+                                 ' proc :',mpi_rank_local
+                 CALL oasis_flush(nulprt)
+                 CALL oasis_abort_noarg()
+             elseif (av_sumd(m) /= 0.0_ip_r8_p) then
+                zlagr = (av_sums(m)/av_sumd(m)) * (wts_sumd/wts_sums)
+                do n = 1,lsized
+                   if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) * zlagr
+                enddo
+             endif
+          enddo
+       else
+           WRITE(nulprt,*) subname,' ERROR: conserv option'
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           CALL oasis_abort_noarg()
+       endif
+
+       if (OASIS_debug >= 20) then
+          call oasis_advance_avsum(av1,av_sums,prism_part(mapper%spart)%gsmap,mpi_comm_local, &
+                                   mask=imasks,wts=areas,consbfb=lconsbfb)
+          call oasis_advance_avsum(avd,av_sumd,prism_part(mapper%dpart)%gsmap,mpi_comm_local, &
+                                   mask=imaskd,wts=aread,consbfb=lconsbfb)
+          write(nulprt,*) subname,' DEBUG src sum af conserve ',av_sums
+          write(nulprt,*) subname,' DEBUG dst sum af conserve ',av_sumd
+          CALL oasis_flush(nulprt)
+       endif
+
+       deallocate(imasks,imaskd,areas,aread)
+       deallocate(av_sums,av_sumd)
+   ENDIF
+   ENDIF  ! present conserve
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_advance_map
+
+!-------------------------------------------------------------------
+
+  SUBROUTINE oasis_advance_avsum(av,sum,gsmap,mpicom,mask,wts,consbfb)
+
+    implicit none
+    type(mct_aVect)      ,intent(in)    :: av      ! av
+    real(kind=ip_r8_p)   ,intent(inout) :: sum(:)  ! sum of av fields
+    type(mct_gsMap)      ,intent(in)    :: gsmap   ! gsmap associate with av
+    integer(kind=ip_i4_p),intent(in)    :: mpicom  ! mpicom
+    integer(kind=ip_i4_p),intent(in),optional :: mask(:) ! mask to apply to av
+    real(kind=ip_r8_p)   ,intent(in),optional :: wts(:)  ! wts to apply to av
+    logical              ,intent(in),optional :: consbfb ! bfb conserve
+
+    integer(kind=ip_i4_p) :: n,m,ierr,mytask
+    integer(kind=ip_i4_p) :: lsize,fsize        ! local size of av, number of flds in av
+    real(kind=ip_r8_p),allocatable  :: lsum(:)  ! local sums
+    real(kind=ip_r8_p),allocatable  :: lwts(:)  ! local wts taking into account mask and wts
+    type(mct_aVect)       :: av1, av1g    ! use av1,av1g for gather and bfb sum
+    logical               :: lconsbfb     ! local conserve bfb
+    character(len=*),parameter :: subname = 'oasis_advance_avsum'
+
+    call oasis_debug_enter(subname)
+
+    lconsbfb = .true.
+    if (present(consbfb)) then
+       lconsbfb = consbfb
+    endif
+
+    fsize = mct_avect_nRattr(av)
+    lsize = mct_avect_lsize(av)
+
+    allocate(lsum(fsize))
+    lsum = 0.0_ip_r8_p
+    allocate(lwts(lsize))
+    lwts = 1.0_ip_r8_p
+
+    if (size(sum) /= fsize) then
+        WRITE(nulprt,*) subname,' ERROR: size sum ne size av'
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+    endif
+
+    if (present(mask)) then
+       if (size(mask) /= lsize) then
+           WRITE(nulprt,*) subname,' ERROR: size mask ne size av'
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           CALL oasis_abort_noarg()
+       endif
+       do n = 1,lsize
+          if (mask(n) /= 0) lwts(n) = 0.0_ip_r8_p
+       enddo
+    endif
+
+    if (present(wts)) then
+       if (size(wts) /= lsize) then
+           WRITE(nulprt,*) subname,' ERROR: size wts ne size av'
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           CALL oasis_abort_noarg()
+       endif
+       do n = 1,lsize
+          lwts(n) = lwts(n) * wts(n)
+       enddo
+    endif
+
+    if (lconsbfb) then
+       call mct_avect_init(av1,av,lsize)
+       do n = 1,lsize
+       do m = 1,fsize
+          av1%rAttr(m,n) = av%rAttr(m,n)*lwts(n)
+       enddo
+       enddo
+       call mct_avect_gather(av1,av1g,gsmap,0,mpicom)
+       call MPI_COMM_RANK(mpicom,mytask,ierr)
+       sum = 0.0_ip_r8_p
+       if (mytask == 0) then
+          do n = 1,mct_avect_lsize(av1g)
+          do m = 1,fsize
+             sum(m) = sum(m) + av1g%rAttr(m,n)
+          enddo
+          enddo
+       endif
+       call oasis_mpi_bcast(sum,mpicom,subname//" bcast sum")
+       call mct_avect_clean(av1)
+    if (mytask == 0) then 
+       call mct_avect_clean(av1g)
+    endif
+    else
+       lsum = 0.0_ip_r8_p
+       do n = 1,lsize
+       do m = 1,fsize
+          lsum(m) = lsum(m) + av%rAttr(m,n)*lwts(n)
+       enddo
+       enddo
+       call oasis_mpi_sum(lsum,sum,mpicom,string=trim(subname)//':sum',all=.true.)
+    endif
+
+    deallocate(lsum)
+    deallocate(lwts)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_advance_avsum
+
+!-------------------------------------------------------------------
+
+  SUBROUTINE oasis_advance_avdiag(av,mpicom,mask,wts)
+
+    implicit none
+    type(mct_aVect)      ,intent(in)    :: av    ! av
+    integer(kind=ip_i4_p),intent(in)    :: mpicom  ! mpicom
+    integer(kind=ip_i4_p),intent(in),optional :: mask(:) ! mask to apply to av
+    real(kind=ip_r8_p)   ,intent(in),optional :: wts(:)  ! wts to apply to av
+
+    integer(kind=ip_i4_p) :: n,m,ierr,mype
+    integer(kind=ip_i4_p) :: lsize,fsize        ! local size of av, number of flds in av
+    logical               :: first_call  
+    real(kind=ip_r8_p)    :: lval               ! local temporary
+    real(kind=ip_r8_p),allocatable  :: lsum(:)  ! local sum
+    real(kind=ip_r8_p),allocatable  :: lmin(:)  ! local min
+    real(kind=ip_r8_p),allocatable  :: lmax(:)  ! local max
+    real(kind=ip_r8_p),allocatable  :: gsum(:)  ! global sum
+    real(kind=ip_r8_p),allocatable  :: gmin(:)  ! global min
+    real(kind=ip_r8_p),allocatable  :: gmax(:)  ! global max
+    real(kind=ip_r8_p),allocatable  :: lwts(:)  ! local wts taking into account mask and wts
+    type(mct_string) :: mstring     ! mct char type
+    character(len=64):: itemc       ! string converted to char
+    character(len=*),parameter :: subname = 'oasis_advance_avdiag'
+
+    call oasis_debug_enter(subname)
+
+    fsize = mct_avect_nRattr(av)
+    lsize = mct_avect_lsize(av)
+
+    allocate(lsum(fsize))
+    allocate(lmin(fsize))
+    allocate(lmax(fsize))
+    allocate(gsum(fsize))
+    allocate(gmin(fsize))
+    allocate(gmax(fsize))
+
+    allocate(lwts(lsize))
+    lwts = 1.0_ip_r8_p
+!!$    lmin=HUGE(lwts)
+!!$    lmax=-lmin
+    if (present(mask)) then
+       if (size(mask) /= lsize) then
+           WRITE(nulprt,*) subname,' ERROR: size mask ne size av'
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           CALL oasis_abort_noarg()
+       endif
+       do n = 1,lsize
+          if (mask(n) /= 0) lwts(n) = 0.0_ip_r8_p
+       enddo
+    endif
+
+    if (present(wts)) then
+       if (size(wts) /= lsize) then
+           WRITE(nulprt,*) subname,' ERROR: size wts ne size av'
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           CALL oasis_abort_noarg()
+       endif
+       do n = 1,lsize
+          lwts(n) = lwts(n) * wts(n)
+       enddo
+    endif
+
+    lsum = 0.0_ip_r8_p
+    do m = 1,fsize
+    first_call = .true.
+    do n = 1,lsize
+       lval = av%rAttr(m,n)*lwts(n)
+       lsum(m) = lsum(m) + lval
+       if (lwts(n) /= 0.0_ip_r8_p) then
+          if (first_call) then
+             lmin(m) = lval
+             lmax(m) = lval
+             first_call = .false.
+          else
+             lmin(m) = min(lmin(m),lval)
+             lmax(m) = max(lmax(m),lval)
+          endif
+       endif
+    enddo
+    enddo
+
+    mype = -1
+    if (mpicom /= MPI_COMM_NULL) then
+       call MPI_COMM_RANK(mpicom,mype,ierr)
+       call oasis_mpi_sum(lsum,gsum,mpicom,string=trim(subname)//':sum',all=.false.)
+       call oasis_mpi_min(lmin,gmin,mpicom,string=trim(subname)//':min',all=.false.)
+       call oasis_mpi_max(lmax,gmax,mpicom,string=trim(subname)//':max',all=.false.)
+    endif
+    if (mype == 0) then
+       do m = 1,fsize
+         call mct_aVect_getRList(mstring,m,av)
+         itemc = mct_string_toChar(mstring)
+         call mct_string_clean(mstring)
+         write(nulprt,'(a,a16,3g21.12)') '   diags: ',trim(itemc),gmin(m),gmax(m),gsum(m)
+       enddo
+    endif
+
+    deallocate(lsum,lmin,lmax)
+    deallocate(gsum,gmin,gmax)
+    deallocate(lwts)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_advance_avdiag
+
+!-------------------------------------------------------------------
+END MODULE mod_oasis_advance
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_auxiliary_routines.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_auxiliary_routines.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_auxiliary_routines.F90	(revision 4775)
@@ -0,0 +1,336 @@
+MODULE mod_oasis_auxiliary_routines
+!---------------------------------------------------------------------
+
+    USE mod_oasis_kinds
+    USE mod_oasis_data
+    USE mod_oasis_parameters
+    USE mod_oasis_coupler
+    USE mod_oasis_timer
+    USE mod_oasis_var
+    USE mod_oasis_sys
+    USE mod_oasis_io
+    USE mod_oasis_mpi
+    USE mct_mod
+
+    implicit none
+    private
+
+    public oasis_get_ncpl
+    public oasis_put_inquire
+    public oasis_get_freqs
+
+#include "oasis_os.h"
+
+    integer(kind=ip_i4_p)     istatus(MPI_STATUS_SIZE)
+
+!---------------------------------------------------------------------
+  CONTAINS
+!---------------------------------------------------------------------
+    SUBROUTINE oasis_get_ncpl(varid, ncpl, kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    INTEGER(kind=ip_i4_p) , INTENT(in)  :: varid
+    INTEGER(kind=ip_i4_p) , INTENT(out) :: ncpl, kinfo
+    !-------------------------------------
+    CHARACTER(len=ic_lvar)  :: vname
+    CHARACTER(len=*),PARAMETER :: subname = 'oasis_get_ncpl'
+    !-------------------------------------
+
+    CALL oasis_debug_enter(subname)
+
+    IF (mpi_comm_local == MPI_COMM_NULL) THEN
+        WRITE(nulprt,*) subname,' ERROR called on non coupling task'
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+    ENDIF
+
+    kinfo = OASIS_OK
+    vname = prism_var(varid)%name
+    
+    IF (varid == OASIS_Var_Uncpl) THEN
+        WRITE(nulprt,*) subname, &
+           ' Routine is called for a variable not in namcouple: it will not be sent'
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+        RETURN
+    ENDIF
+    
+    ncpl  = prism_var(varid)%ncpl
+    
+    IF (ncpl <= 0) THEN
+        IF (OASIS_debug >= 2) WRITE(nulprt,*) subname,' variable not coupled ',&
+                               TRIM(vname)
+        CALL oasis_debug_exit(subname)
+        RETURN
+    ELSE 
+        IF (OASIS_debug >= 2)  WRITE(nulprt,*) subname,' Variable: ',TRIM(vname),&
+                               ' used in ',ncpl,' couplings' 
+        CALL oasis_flush(nulprt)
+    ENDIF
+    
+  END SUBROUTINE oasis_get_ncpl
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_get_freqs(varid, ncpl, cpl_freqs, kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    INTEGER(kind=ip_i4_p) , INTENT(in)  :: varid, ncpl
+    INTEGER(kind=ip_i4_p) , INTENT(out) :: cpl_freqs(ncpl), kinfo
+    !-------------------------------------
+    CHARACTER(len=ic_lvar)  :: vname
+    INTEGER(kind=ip_i4_p)   :: ncpl_calc, cplid, nc
+    CHARACTER(len=*),PARAMETER :: subname = 'oasis_get_freqs'
+    !-------------------------------------
+
+    CALL oasis_debug_enter(subname)
+
+    IF (mpi_comm_local == MPI_COMM_NULL) THEN
+        WRITE(nulprt,*) subname,' ERROR called on non coupling task'
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+    ENDIF
+
+    kinfo = OASIS_OK
+    vname = prism_var(varid)%name
+    
+    IF (varid == OASIS_Var_Uncpl) THEN
+        WRITE(nulprt,*) subname, &
+           ' Routine is called for a variable not in namcouple: it will not be sent'
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+        RETURN
+    ENDIF
+    
+    ncpl_calc  = prism_var(varid)%ncpl
+
+    IF (ncpl_calc /= ncpl) THEN
+        WRITE(nulprt,*) subname,' Wrong number of couplings for variable: ',TRIM(vname), &
+                        ncpl_calc, ncpl
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+    ENDIF
+    
+    IF (ncpl <= 0) THEN
+        IF (OASIS_debug >= 2) WRITE(nulprt,*) subname,' variable not coupled ',&
+                               TRIM(vname)
+        CALL oasis_flush(nulprt)
+        CALL oasis_debug_exit(subname)
+        RETURN
+    ENDIF
+
+    DO nc = 1,prism_var(varid)%ncpl
+      cplid           = prism_var(varid)%cpl(nc)
+      cpl_freqs(nc)   = prism_coupler(cplid)%dt
+
+      IF (OASIS_Debug >=2 ) THEN
+          WRITE(nulprt,*)  subname,' Coupling frequency of this field ',TRIM(vname),&
+                           ' for coupling ',nc, ' is ',cpl_freqs(nc)
+      ENDIF
+
+      IF (cpl_freqs(nc) .le. 0) THEN
+          WRITE(nulprt,*) subname,' The coupling frequency is < or equal to 0'
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE oasis_get_freqs
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_put_inquire(varid,msec,kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in)  :: varid, msec
+    integer(kind=ip_i4_p) , intent(out) :: kinfo
+    !-------------------------------------
+    character(len=ic_lvar)     :: vname
+    INTEGER(kind=ip_i4_p)      :: ncpl, nc, cplid
+    INTEGER(kind=ip_i4_p)      :: lag, mseclag, trans, dt, getput, maxtime
+    LOGICAL                    :: time_now, sndrcv, output
+    character(len=*),parameter :: subname = 'oasis_put_inquire'
+    !-------------------------------------
+
+    CALL oasis_debug_enter(subname)
+
+    IF (mpi_comm_local == MPI_COMM_NULL) THEN
+        WRITE(nulprt,*) subname,' ERROR called on non coupling task'
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+    ENDIF
+
+    kinfo = OASIS_OK
+    vname = prism_var(varid)%name
+    
+    IF (varid == OASIS_Var_Uncpl) THEN
+        WRITE(nulprt,*) subname, &
+           ' Routine oasis_put is called for a variable not in namcouple: it will not be sent'
+        CALL oasis_flush(nulprt)
+        CALL oasis_abort_noarg()
+        RETURN
+    ENDIF
+    
+    ncpl  = prism_var(varid)%ncpl
+    
+    IF (ncpl <= 0) THEN
+        IF (OASIS_debug >= 2) WRITE(nulprt,*) subname,' variable not coupled ',&
+                               TRIM(vname)
+        CALL oasis_debug_exit(subname)
+        RETURN
+    ENDIF
+
+    DO nc = 1,prism_var(varid)%ncpl
+
+      cplid   = prism_var(varid)%cpl(nc)
+      dt      = prism_coupler(cplid)%dt
+      lag     = prism_coupler(cplid)%lag
+      getput  = prism_coupler(cplid)%getput
+      sndrcv  = prism_coupler(cplid)%sndrcv
+      maxtime = prism_coupler(cplid)%maxtime
+      output  = prism_coupler(cplid)%output
+
+      !------------------------------------------------
+      ! check that lag is reasonable
+      !------------------------------------------------
+
+      IF (ABS(lag) > dt) THEN
+          WRITE(nulprt,*) subname,' ERROR lag gt dt for cplid',cplid
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+      ENDIF
+
+      !------------------------------------------------
+      ! check that field is OASIS_PUT
+      !------------------------------------------------
+
+      IF (getput == OASIS3_GET) THEN
+          WRITE(nulprt,*) subname,' ERROR : routine can only be called for OASIS_PUT variable'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+      ENDIF
+
+      CALL oasis_debug_note(subname//' set mseclag')
+      IF (getput == OASIS3_PUT) THEN
+          mseclag = msec + lag
+      ENDIF
+
+       !------------------------------------------------
+       ! check that model hasn't gone past maxtime
+       !------------------------------------------------
+
+       if (msec >= maxtime) then
+          write(nulprt,*) subname,' at ',msec,mseclag,'  ERROR: ',trim(vname)
+          write(nulprt,*) subname,' ERROR model time beyond namcouple maxtime',&
+                          msec,maxtime
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+          call oasis_abort_noarg()
+       endif
+
+      time_now = .FALSE.
+      IF (MOD(mseclag,dt) == 0) time_now = .TRUE.
+
+      !-------------------------------------------------------------------
+      ! Test what is the current status of the field if time_now = .TRUE.
+      !-------------------------------------------------------------------
+
+      IF (time_now .EQV. .TRUE.) THEN
+          !
+          IF (OASIS_debug >= 2) THEN
+              WRITE(nulprt,*) subname,' Coupling time for : ',trim(vname)
+              WRITE(nulprt,*) subname,'  Coupling time for var for nc : ',&
+                  TRIM(mct_avect_exportRList2c(prism_coupler(cplid)%avect1)),nc
+              WRITE(nulprt,*) subname,' dt,msec,mseclag = ',dt,msec,mseclag
+              CALL oasis_flush(nulprt)
+          ENDIF
+
+          IF ( (trans == ip_average) .OR. (trans == ip_accumul) .OR. (trans == ip_max) &
+             .OR. (trans == ip_min) ) THEN
+              IF (kinfo == OASIS_OK) kinfo = OASIS_LocTrans
+              IF (OASIS_debug >= 2) THEN
+                  WRITE(nulprt,*) subname,' status at ',msec,mseclag,' WTRN '
+                  CALL oasis_flush(nulprt)
+              ENDIF
+          ENDIF
+
+          !-------------------------------------------------------------------
+          ! past namcouple runtime (maxtime) no communication
+          ! do restart if time+lag = maxtime, this assumes coupling
+          ! period and lag and maxtime are all nicely consistent
+          !-------------------------------------------------------------------
+          IF (mseclag >= maxtime) THEN
+              IF (getput == OASIS3_PUT .AND. lag > 0 .AND. mseclag == maxtime) THEN
+                  kinfo = OASIS_ToRest
+                  IF (OASIS_debug >= 2) THEN
+                      WRITE(nulprt,*) subname,' status at ',msec,mseclag,' WRST '
+                      CALL oasis_flush(nulprt)
+                  ENDIF
+              ENDIF
+          ENDIF
+          
+          !------------------------------------------------
+          ! communication
+          !------------------------------------------------
+          IF (sndrcv) THEN
+              IF (getput == OASIS3_PUT) THEN
+                  kinfo = OASIS_sent
+                  IF (OASIS_debug >= 2) THEN
+                      WRITE(nulprt,*) subname,' status at ',msec,mseclag,' will be SENT '
+                      CALL oasis_flush(nulprt)
+                  ENDIF
+                  
+              ENDIF
+          ENDIF
+
+          !------------------------------------------------
+          ! save debug file if EXPOUT or OUTPUT
+          !------------------------------------------------
+          IF (output) THEN
+              IF (kinfo == OASIS_sent) THEN
+                  kinfo = OASIS_sentout
+              ELSEIF (kinfo == OASIS_torest) THEN
+                  kinfo = OASIS_torestout
+              ELSE
+                  kinfo = OASIS_output
+              ENDIF
+              IF (OASIS_debug >= 2) THEN
+                  WRITE(nulprt,*) subname,' status at ',msec,mseclag,' will be WRIT '
+                  CALL oasis_flush(nulprt)
+              ENDIF
+          ENDIF
+
+          !------------------------------------------------
+          ! sav non-instant loctrans operations for future restart
+          !   at the end of the run only
+          !------------------------------------------------
+
+          IF (mseclag + dt >= maxtime .AND. &
+             getput == OASIS3_PUT .and. trans /= ip_instant) then
+              IF (OASIS_debug >= 2) THEN
+                  WRITE(nulprt,*) subname,' at ',msec,mseclag,' will be WTRN: '
+                  CALL oasis_flush(nulprt)
+              ENDIF
+          ENDIF
+      ELSE
+          IF (OASIS_Debug >=2) THEN
+              WRITE(nulprt,*) 'Nothing to do'
+          ENDIF
+      ENDIF ! time_now
+      IF (OASIS_debug >= 2) THEN
+          WRITE(nulprt,*) subname,' kinfo: ',kinfo
+          CALL oasis_flush(nulprt)
+      ENDIF
+    ENDDO
+
+      CALL oasis_debug_exit(subname)
+
+    END SUBROUTINE oasis_put_inquire
+
+!---------------------------------------------------------------------------------
+  END MODULE mod_oasis_auxiliary_routines
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_coupler.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_coupler.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_coupler.F90	(revision 4775)
@@ -0,0 +1,1976 @@
+MODULE mod_oasis_coupler
+!     - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+  USE mod_oasis_kinds
+  USE mod_oasis_data
+  USE mod_oasis_parameters
+  USE mod_oasis_namcouple
+  USE mod_oasis_sys
+  USE mod_oasis_var, only : prism_nvar
+  USE mod_oasis_part
+  USE mod_oasis_mpi
+  USE mod_oasis_string
+  USE mod_oasis_io
+  USE mod_oasis_timer
+  USE mct_mod
+  USE grids    ! scrip
+  USE netcdf
+
+  IMPLICIT NONE
+
+  private
+
+  public oasis_coupler_setup
+
+! Type of data
+
+  public prism_router_type
+  public prism_mapper_type
+  public prism_coupler_type
+
+  !--- derived ---
+  INTEGER(kind=ip_i4_p),pointer :: model_root(:)
+
+! COUPLING INFO
+
+  type prism_router_type
+     !--- fixed at initialization ---
+     type(mct_router)      :: router     ! router
+  end type prism_router_type
+
+  type prism_mapper_type
+     !--- fixed at initialization ---
+     type(mct_sMatP),pointer :: sMatP(:)  ! mappers, size nwgts
+     integer(kind=ip_i4_p) :: nwgts       ! number of weights in weights file
+     character(len=ic_long):: file
+     character(len=ic_med) :: loc         ! location: src,dst
+     character(len=ic_med) :: opt         ! optimization: bfb,sum,opt
+     character(len=ic_med) :: optval      ! mct map option: src,dst
+     logical               :: init
+     integer(kind=ip_i4_p) :: spart ! src partition
+     integer(kind=ip_i4_p) :: dpart ! dst partition
+     character(len=ic_med) :: srcgrid     !< source grid name
+     character(len=ic_med) :: dstgrid     !< target grid name
+     logical               :: AVred ! AV_ms, AV_md data already read in
+     type(mct_aVect)       :: AV_ms ! av for CONSERV src: mask, area, etc
+     type(mct_aVect)       :: AV_md ! av for CONSERV dst: mask, area, etc
+  end type prism_mapper_type
+
+  integer(kind=ip_i4_p),public,parameter :: prism_coupler_avsmax=5
+
+  type prism_coupler_type
+     !--- fixed at initialization ---
+     type(mct_aVect)       :: aVect1   ! primary aVect
+     type(mct_aVect)       :: aVect1m  ! extra aVect needed for mapping
+     type(mct_aVect)       :: aVect2   ! aVects 2-5 handle higher order mapping
+     type(mct_aVect)       :: aVect3   ! 
+     type(mct_aVect)       :: aVect4   ! 
+     type(mct_aVect)       :: aVect5   ! 
+     logical               :: aVon(prism_coupler_avsmax)  ! flags indicating whether aVects 2-5 are active
+     character(len=ic_xl)  :: rstfile  ! restart file
+     character(len=ic_xl)  :: inpfile  ! restart file
+     character(len=ic_xl)  :: fldlist  ! field list
+     integer(kind=ip_i4_p) :: nflds    ! number of fields
+     integer(kind=ip_i4_p),pointer :: varid(:)    ! varid for each field
+     integer(kind=ip_i4_p) :: namID    ! namcouple ID
+     integer(kind=ip_i4_p) :: partID   ! associated partition ID
+     integer(kind=ip_i4_p) :: routerID ! router ID
+     integer(kind=ip_i4_p) :: mapperID ! mapper ID
+     character(len=ic_med) :: maploc   ! map location: src,dst
+     integer(kind=ip_i4_p) :: ops      ! namcouple operation (ip_exported,...)
+     integer(kind=ip_i4_p) :: comp     ! other model compid
+     integer(kind=ip_i4_p) :: tag      ! comm tag
+     integer(kind=ip_i4_p) :: seq      ! sequence number
+     integer(kind=ip_i4_p) :: dt       ! coupling period (secs)
+     integer(kind=ip_i4_p) :: lag      ! put lag += put sooner (secs)
+     integer(kind=ip_i4_p) :: maxtime  ! max time for the coupler
+     integer(kind=ip_i4_p) :: trans    ! transformation (ip_average,...)
+     integer(kind=ip_i4_p) :: conserv  ! conserve operation (ip_cnone,ip_cglobal,...)
+     character(len=ic_med) :: consopt  ! conserve option (bfb, opt)
+     integer(kind=ip_i4_p) :: getput   ! get/put flag
+     logical               :: sndrcv   ! send recv flag
+     logical               :: output   ! output flag
+     logical               :: input    ! input flag
+     logical               :: snddiag  ! diagnose src fields as part of coupling
+     logical               :: rcvdiag  ! diagnose rcv fields as part of coupling
+     real(kind=ip_double_p):: sndmult  ! field multiplier term
+     real(kind=ip_double_p):: sndadd   ! field addition term
+     real(kind=ip_double_p):: rcvmult  ! field multiplier term
+     real(kind=ip_double_p):: rcvadd   ! field addition term
+     !--- time varying info ---
+     integer(kind=ip_i4_p) :: ltime    ! time at last coupling
+     integer(kind=ip_i4_p),pointer :: avcnt(:)  ! counter for averaging
+     integer(kind=ip_i4_p),pointer :: status(:) ! status of variables in coupler
+  end type prism_coupler_type
+
+  integer(kind=ip_i4_p)           :: prism_mrouter   ! max routers
+  integer(kind=ip_i4_p)           :: prism_nrouter = 0
+  type(prism_router_type) ,public, pointer:: prism_router(:)
+
+  integer(kind=ip_i4_p)           :: prism_mmapper   ! max mappers
+  integer(kind=ip_i4_p)           :: prism_nmapper = 0
+  type(prism_mapper_type) ,public, pointer :: prism_mapper(:)
+
+  integer(kind=ip_i4_p)           :: prism_mcoupler   ! max couplers
+  integer(kind=ip_i4_p)   ,public :: prism_ncoupler = 0
+  type(prism_coupler_type),public, pointer :: prism_coupler(:)
+
+  integer(kind=ip_i4_p)   ,public :: lcouplerid    ! last coupler id
+  integer(kind=ip_i4_p)   ,public :: lcouplertime  ! last coupler time 
+
+
+!#include <netcdf.inc>
+
+!------------------------------------------------------------
+CONTAINS
+!------------------------------------------------------------
+
+  SUBROUTINE oasis_coupler_setup()
+
+  !----------------------------------------------------------
+  ! This routine reconciles the coupling stuff
+  !----------------------------------------------------------
+
+  IMPLICIT none
+
+  integer(kind=ip_i4_p) :: n,n1,nn,nv,nm,nv1,nns,lnn,nc
+  integer(kind=ip_i4_p) :: pe
+  integer(kind=ip_i4_p) :: part1, part2
+  integer(kind=ip_i4_p) :: spart,dpart,rpart ! src, dst, router partition id
+        ! part1 = my local part
+        ! part2 = other part
+        ! spart = src part for mapping; put=part1, get=part2
+        ! dpart = dst part for mapping; put=part2, get=part1
+        ! rpart = part used for router init
+  integer(kind=ip_i4_p) :: mapID,namID
+  type(mct_sMat),pointer :: sMati(:)
+  integer(kind=ip_i4_p) :: ncid,dimid,status
+  integer(kind=ip_i4_p) :: lsize,gsize
+  integer(kind=ip_i4_p) :: svarid
+  integer(kind=ip_i4_p),allocatable :: varidtmp(:)
+  integer(kind=ip_i4_p) :: part
+  character(len=ic_lvar):: cstring
+  character(len=ic_lvar):: myfld
+  integer(kind=ip_i4_p) :: myfldi
+  character(len=ic_lvar):: otfld
+  character(len=ic_lvar):: otfldmatch
+  integer(kind=ip_i4_p) :: otfldi
+  integer(kind=ip_i4_p) :: nx,ny
+  character(len=ic_lvar):: gridname
+  character(len=ic_long):: tmp_mapfile
+  integer(kind=ip_i4_p) :: flag
+  logical               :: found, exists
+  integer(kind=ip_i4_p) :: mynvar
+  integer(kind=ip_i4_p) :: nwgts
+  character(len=ic_lvar),pointer :: myvar(:)
+  integer(kind=ip_i4_p) ,pointer :: myops(:)
+  integer(kind=ip_i4_p) ,pointer :: nallvar(:)
+  character(len=ic_lvar),pointer :: allvar(:,:)
+  integer(kind=ip_i4_p) ,pointer :: allops(:,:)
+  character(len=*),parameter :: subname = 'oasis_coupler_setup'
+
+  !----------------------------------------------------------
+
+  !----------------------------------------------------------
+  ! Figure out the global rank of each model's root
+  !----------------------------------------------------------
+
+  call oasis_debug_enter(subname)
+  call oasis_timer_start('cpl_setup')
+
+  allocate(model_root(prism_nmodels))
+  model_root = -99
+  do n = 1,prism_nmodels
+     pe = -1
+     if (compid == n .and. mpi_rank_local == 0) pe = mpi_rank_global
+     call oasis_mpi_max(pe,model_root(n),mpi_comm_global, &
+        subname//':cg',.true.)
+  enddo
+
+  if ( OASIS_debug >= 2 ) write(nulprt,*) subname,' model_root = ',&
+                                          model_root(1:prism_nmodels)
+
+  ! allocate prism_router, prism_mapper, prism_coupler based on nnamcpl
+  ! there cannot be more than that needed
+
+  lnn=-1
+  call oasis_debug_note(subname//' set defaults for datatypes')
+
+  prism_mrouter = nnamcpl
+  allocate(prism_router(prism_mrouter))
+  prism_nrouter = 0
+
+  prism_mmapper = nnamcpl
+  allocate(prism_mapper(prism_mmapper))
+  prism_nmapper = 0
+  prism_mapper(:)%nwgts = 0
+  prism_mapper(:)%file  = ""
+  prism_mapper(:)%loc   = ""
+  prism_mapper(:)%opt   = ""
+  prism_mapper(:)%optval= ""
+  prism_mapper(:)%init  = .false.
+  prism_mapper(:)%spart = ispval
+  prism_mapper(:)%dpart = ispval
+  prism_mapper(:)%AVred = .false.
+
+  prism_mcoupler = nnamcpl
+  allocate(prism_coupler(prism_mcoupler))
+  prism_ncoupler = 0
+  prism_coupler(:)%rstfile = ""
+  prism_coupler(:)%inpfile = ""
+  prism_coupler(:)%fldlist = ""
+  prism_coupler(:)%nflds   = 0
+  do nc = 1,nnamcpl
+     allocate(prism_coupler(nc)%varid(1))
+     prism_coupler(nc)%varid(:) = ispval
+     prism_coupler(nc)%aVon(:) = .false.
+  enddo
+  if (OASIS_debug >= 2) write(nulprt,*) subname,' initialize %varid ',&
+                                        nnamcpl,size(prism_coupler(nnamcpl)%varid)
+  prism_coupler(:)%ops     = ispval
+  prism_coupler(:)%comp    = ispval
+  prism_coupler(:)%routerID  = ispval
+  prism_coupler(:)%mapperID  = ispval
+  prism_coupler(:)%maploc  = ""
+  prism_coupler(:)%tag     = ispval
+  prism_coupler(:)%dt      = ispval
+  prism_coupler(:)%lag     = 0
+  prism_coupler(:)%maxtime = 0
+  prism_coupler(:)%getput  = ispval
+  prism_coupler(:)%sndrcv  = .false.
+  prism_coupler(:)%output  = .false.
+  prism_coupler(:)%input   = .false.
+  prism_coupler(:)%trans   = ip_instant
+  prism_coupler(:)%conserv = ip_cnone
+  prism_coupler(:)%ltime   = ispval
+  prism_coupler(:)%snddiag = .false.
+  prism_coupler(:)%rcvdiag = .false.
+  prism_coupler(:)%sndmult = 1.0_ip_double_p
+  prism_coupler(:)%sndadd  = 0.0_ip_double_p
+  prism_coupler(:)%rcvmult = 1.0_ip_double_p
+  prism_coupler(:)%rcvadd  = 0.0_ip_double_p
+
+  lcouplerid   = ispval
+  lcouplertime = ispval
+
+  !----------------------------------------------------------
+  ! Share model variable information across all models
+  !----------------------------------------------------------
+
+  call oasis_debug_note(subname//' share var info between models')
+
+  allocate(allvar(mvar,prism_nmodels))
+  allocate(nallvar(prism_nmodels))
+  allocate(allops(mvar,prism_nmodels))
+  allocate(myvar(mvar))
+  allocate(myops(mvar))
+
+  allvar = " "
+  nallvar = 0
+  allops = -1
+  do n = 1,prism_nmodels
+     if (n == compid) then
+        myvar = " "
+        myops = 0
+        mynvar = prism_nvar
+        do n1 = 1, prism_nvar
+           myvar(n1) = trim(prism_var(n1)%name)
+           myops(n1) = prism_var(n1)%ops
+        enddo
+     endif
+     if (OASIS_debug >= 5) then
+        write(nulprt,*) subname,' BCAST from ',n,model_root(n)
+        call oasis_flush(nulprt)
+     endif
+     call oasis_mpi_bcast(mynvar,mpi_comm_global,'mynvar',model_root(n))
+     if (OASIS_debug >= 5) then
+        write(nulprt,*) subname,' bcast mynvar ',mynvar
+        call oasis_flush(nulprt)
+     endif
+     nallvar(n) = mynvar
+     call oasis_mpi_bcast(myvar,mpi_comm_global,'myvar',model_root(n))
+     if (OASIS_debug >= 5) then
+        write(nulprt,*) subname,' bcast myvar ',trim(myvar(1))
+        call oasis_flush(nulprt)
+     endif
+     allvar(:,n) = myvar(:)
+     call oasis_mpi_bcast(myops,mpi_comm_global,'myops',model_root(n))
+     if (OASIS_debug >= 5) then
+        write(nulprt,*) subname,' bcast myops ',myops(1)
+        call oasis_flush(nulprt)
+     endif
+     allops(:,n) = myops(:)
+  enddo
+
+  deallocate(model_root)
+  deallocate(myvar,myops)
+
+  if (OASIS_debug >= 2) then
+     write(nulprt,*) subname,' model variable info:'
+     do nm = 1,prism_nmodels
+        write(nulprt,'(8x,a,2i6)') ' model,nvars = ',nm,nallvar(nm)
+        do nv = 1,nallvar(nm)
+           cstring = 'unknown'
+           if (allops(nv,nm) == OASIS_Out) cstring = 'prism_out'
+           if (allops(nv,nm) == OASIS_In)  cstring = 'prism_in'
+           write(nulprt,'(16x,a,2i6,2x,a,i6,2x,a)') ' model,idx,var,ops = ',nm,nv,&
+                                                      trim(allvar(nv,nm)),allops(nv,nm),&
+                                                      trim(cstring)
+        enddo
+     enddo
+     write(nulprt,*) ' '
+     call oasis_flush(nulprt)
+  endif
+
+  !----------------------------------------------------------
+  ! Setup couplers based on namcouple and model variable info
+  ! These must be paired up consistently, create couplers in
+  ! sorted order (nns)
+  ! nn = namcpl counter, sorted
+  ! nm = model counter, compid is my nm
+  ! nv = variable counter
+  ! nv1 = my variable counter
+  !----------------------------------------------------------
+
+  prism_ncoupler = 0
+
+  !--------------------------------
+  ! for all namcoupler input
+  !--------------------------------
+
+  call oasis_debug_note(subname//' compare vars and namcouple')
+  call oasis_debug_note(subname//' setup couplers')
+
+  do nns = 1,nnamcpl
+     nn = namfldsort(nns)
+
+     !--- tcx require for run time error on corail ????----
+     call oasis_mpi_barrier(mpi_comm_global)
+     IF (OASIS_debug >= 2) THEN
+         WRITE(nulprt,*) subname,' check nam ',nns
+         CALL oasis_flush(nulprt)
+     ENDIF
+
+     !--------------------------------
+     ! for all my variables
+     !--------------------------------
+
+     do nv1 = 1,nallvar(compid)
+
+        !--- tcx require for run time error on corail ????----
+        IF (OASIS_debug >= 2) THEN
+           WRITE(nulprt,*) subname,' check var ',nns,nv1
+           CALL oasis_flush(nulprt)
+        ENDIF
+
+        !--------------------------------
+        ! get my parition and fld
+        !--------------------------------
+
+        part1  = prism_var(nv1)%part
+        myfld  = trim(allvar(nv1,compid))
+
+        IF (OASIS_debug >= 20) THEN
+            WRITE(nulprt,*) subname,' get part and fld ',part1,trim(myfld)
+            CALL oasis_flush(nulprt)
+        ENDIF
+
+        !--------------------------------
+        ! check if i'm an In or Out variable
+        ! check if my variable matches this namcouple dst or src
+        !--------------------------------
+        flag = OASIS_NotDef
+        if (allops(nv1,compid) == OASIS_Out) then
+           myfldi = oasis_string_listGetIndexF(namsrcfld(nn),myfld)
+           if (myfldi > 0) flag = OASIS_Out
+        elseif (allops(nv1,compid) == OASIS_In) then
+           myfldi = oasis_string_listGetIndexF(namdstfld(nn),myfld)
+           if (myfldi > 0) flag = OASIS_In
+        endif
+
+        IF (OASIS_debug >= 20) THEN
+            WRITE(nulprt,*) subname,' check fld ',myfldi,flag
+            CALL oasis_flush(nulprt)
+        ENDIF
+
+        !--------------------------------
+        ! my variable is in this namcouple input
+        !--------------------------------
+
+        if (flag /= OASIS_NotDef) then
+
+           !--------------------------------
+           ! migrate namcouple info into part
+           !--------------------------------
+
+           IF (OASIS_debug >= 20) THEN
+               WRITE(nulprt,*) subname,' migrate namcouple '
+               CALL oasis_flush(nulprt)
+           ENDIF
+
+           if (flag == OASIS_In) then
+              if (prism_part(part1)%nx < 1) then
+                 prism_part(part1)%nx = namdst_nx(nn)
+                 prism_part(part1)%ny = namdst_ny(nn)
+                 prism_part(part1)%gridname = trim(namdstgrd(nn))
+              endif
+           endif
+           if (flag == OASIS_Out) then
+              if (prism_part(part1)%nx < 1) then
+                 prism_part(part1)%nx = namsrc_nx(nn)
+                 prism_part(part1)%ny = namsrc_ny(nn)
+                 prism_part(part1)%gridname = trim(namsrcgrd(nn))
+              endif
+           endif
+
+           !--------------------------------
+           ! make sure it's either an In or Out, sanity check
+           !--------------------------------
+
+           if (flag /= OASIS_In .and. flag /= OASIS_Out) then
+              write(nulprt,*) subname,' ERROR flag problems',flag
+              WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+              CALL oasis_flush(nulprt)
+              call oasis_abort_noarg()
+           endif
+
+           if (OASIS_debug >= 5) then
+              write(nulprt,'(1x,2a,4i6,2a)') subname,' ca: myfld',nn,compid,&
+                                             nv1,myfldi,' ',trim(myfld)
+              call oasis_flush(nulprt)
+           endif
+
+           !--------------------------------
+           ! determine other field
+           !--------------------------------
+
+           otfldmatch = 'NOmatchNOyesNOyesNO'
+           if (flag == OASIS_Out) then
+              call oasis_string_listGetName(namdstfld(nn),myfldi,otfldmatch)
+           endif
+           if (flag == OASIS_In) then
+              call oasis_string_listGetName(namsrcfld(nn),myfldi,otfldmatch)
+           endif
+
+           !--------------------------------
+           ! look for namcouple coupling variable in all other model variables
+           !--------------------------------
+
+           found = .false.
+           do nm = 1,prism_nmodels
+           do nv = 1,nallvar(nm)
+
+              !--- tcx require for run time error on corail ????----
+              IF (OASIS_debug >= 2) THEN
+                  WRITE(nulprt,*) subname,' check mod ',nns,nv1,nm,nv
+                  CALL oasis_flush(nulprt)
+              ENDIF
+
+              otfld  = trim(allvar(nv,nm))
+              otfldi = -1
+
+              !--------------------------------
+              ! matches if the var field and nam field are the same
+              !--------------------------------
+
+              if (trim(otfldmatch) == trim(otfld)) then
+
+                 if (OASIS_debug >= 2) write(nulprt,*) subname,' check fld ',&
+                                                       nns,nv1,nm,nv,otfldi
+
+                 if (OASIS_debug >= 5) then
+                    write(nulprt,'(1x,2a,4i6,2a)') subname,' ca: otfld',nn,nm,&
+                                                   nv,otfldi,' ',trim(otfld)
+                    call oasis_flush(nulprt)
+                 endif
+
+                 !--------------------------------
+                 ! Do not allow src and dst to be on same model for communication
+                 ! Make sure one side is In and other side is Out for communication
+                 ! If input or output, field name should match
+                 !--------------------------------
+
+                 if (namfldops(nn) == ip_exported .or. namfldops(nn) == ip_expout) then
+                    if (nm == compid) then
+                       write(nulprt,*) subname,' ERROR send recv pair on same model',nm,' ', &
+                          trim(myfld),' ',trim(otfld)
+                       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                       CALL oasis_flush(nulprt)
+                       call oasis_abort_noarg()
+                    endif
+                    if (flag == OASIS_Out .and. allops(nv,nm) /= OASIS_In) then
+                       write(nulprt,*) subname,' ERROR send recv pair both Out ', &
+                          trim(myfld),' ',trim(otfld)
+                       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                       CALL oasis_flush(nulprt)
+                       call oasis_abort_noarg()
+                    endif
+                    if (flag == OASIS_In .and. allops(nv,nm) /= OASIS_Out) then
+                       write(nulprt,*) subname,' ERROR send recv pair both In ', &
+                          trim(myfld),' ',trim(otfld)
+                       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                       CALL oasis_flush(nulprt)
+                       call oasis_abort_noarg()
+                    endif
+                 endif
+
+                 if (namfldops(nn) == ip_input .or. namfldops(nn) == ip_output) then
+                    if (trim(myfld) /= trim(otfld)) then
+                       write(nulprt,*) subname,' ERROR namcouple field names to not match for in/out', &
+                          trim(myfld),' ',trim(otfld)
+                       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                       CALL oasis_flush(nulprt)
+                       call oasis_abort_noarg()
+                    endif
+                 endif
+
+                 !--------------------------------
+                 ! Only an error to find two sources for a destination
+                 ! Not an error if a two destinations have a single source
+                 !--------------------------------
+
+                 if (flag == OASIS_In .and. found) then
+                    write(nulprt,*) subname,' ERROR found two sources for ',trim(otfld)
+                    WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                    CALL oasis_flush(nulprt)
+                    call oasis_abort_noarg()
+                 endif
+                 found = .true.
+
+                 !--------------------------------
+                 ! only increment prism_ncoupler if new nn (coupler), otherwise use prior prism_ncoupler
+                 ! this supports multiple fields coupled in one communication step
+                 !--------------------------------
+
+                 if (nn /= lnn) prism_ncoupler = prism_ncoupler + 1
+                 lnn = nn
+                 if (prism_ncoupler > prism_mcoupler) then
+                    write(nulprt,*) subname,' ERROR prism_ncoupler too large',prism_ncoupler,prism_mcoupler
+                    WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                    CALL oasis_flush(nulprt)
+                    call oasis_abort_noarg()
+                 endif
+                 nc = prism_ncoupler
+
+                 !--------------------------------
+                 ! prism_coupler fields, multiple field support
+                 !--------------------------------
+
+                 IF (OASIS_debug >= 20) THEN
+                     WRITE(nulprt,*) subname,' set prism_coupler '
+                     CALL oasis_flush(nulprt)
+                 ENDIF
+
+                 prism_coupler(nc)%nflds = prism_coupler(nc)%nflds + 1
+                 if (prism_coupler(nc)%nflds == 1) then
+                    prism_coupler(nc)%fldlist = trim(myfld)
+                 else
+                    prism_coupler(nc)%fldlist = trim(prism_coupler(nc)%fldlist)//':'//trim(myfld)
+                 endif
+
+                 svarid = size(prism_coupler(nc)%varid)
+                 if (prism_coupler(nc)%nflds > svarid) then
+                     allocate(varidtmp(svarid))
+                     varidtmp(1:svarid) = prism_coupler(nc)%varid(1:svarid)
+                     deallocate(prism_coupler(nc)%varid)
+                     allocate(prism_coupler(nc)%varid(prism_coupler(nc)%nflds+10))
+                     prism_coupler(nc)%varid(1:svarid) = varidtmp(1:svarid)
+                     deallocate(varidtmp)
+                 endif
+                 prism_coupler(nc)%varid(prism_coupler(nc)%nflds) = nv1
+
+                 !--------------------------------
+                 ! prism_coupler other settings
+                 !--------------------------------
+
+                 prism_coupler(nc)%comp   = nm
+                 prism_coupler(nc)%seq    = namfldseq(nn)
+                 prism_coupler(nc)%dt     = namflddti(nn)
+                 prism_coupler(nc)%lag    = namfldlag(nn)
+                 prism_coupler(nc)%maxtime= namruntim
+                 prism_coupler(nc)%rstfile= trim(namrstfil(nn))
+                 prism_coupler(nc)%inpfile= trim(naminpfil(nn))
+                 prism_coupler(nc)%mapperID = -1
+                 prism_coupler(nc)%partID = part1
+                 prism_coupler(nc)%namID  = nn
+                 prism_coupler(nc)%trans  = namfldtrn(nn)
+                 prism_coupler(nc)%conserv= namfldcon(nn)
+                 prism_coupler(nc)%consopt= namfldcoo(nn)
+                 prism_coupler(nc)%ops    = namfldops(nn)
+                 prism_coupler(nc)%tag    = compid*100*1000 + compid*1000 + nn
+                 prism_coupler(nc)%getput = OASIS_NotDef
+                 prism_coupler(nc)%sndrcv = .false.
+                 prism_coupler(nc)%output = .false.
+                 prism_coupler(nc)%input  = .false.
+                 prism_coupler(nc)%sndmult= namfldsmu(nn)
+                 prism_coupler(nc)%sndadd = namfldsad(nn)
+                 prism_coupler(nc)%rcvmult= namflddmu(nn)
+                 prism_coupler(nc)%rcvadd = namflddad(nn)
+                 prism_coupler(nc)%snddiag= namchecki(nn)
+                 prism_coupler(nc)%rcvdiag= namchecko(nn)
+
+                 !--------------------------------
+                 ! prism_coupler input and output flags
+                 ! prism_coupler comm flags, need for tags to match up on both sides
+                 ! tags assume up to 1000 namcouple inputs and 100 models
+                 !--------------------------------
+
+                 IF (OASIS_debug >= 20) THEN
+                     WRITE(nulprt,*) subname,' inout flags '
+                     CALL oasis_flush(nulprt)
+                 ENDIF
+
+                 if (namfldops(nn) == ip_output .or. namfldops(nn) == ip_expout) then
+                    prism_coupler(nc)%output = .true.
+                    prism_coupler(nc)%getput = OASIS3_PUT
+                 endif
+                 if (namfldops(nn) == ip_input) then
+                    prism_coupler(nc)%input  = .true.
+                    prism_coupler(nc)%getput = OASIS3_GET
+                 endif
+
+                 if (namfldops(nn) == ip_exported .or. namfldops(nn) == ip_expout) then
+                    prism_coupler(nc)%sndrcv = .true.
+                    if (flag == OASIS_Out) then
+                       prism_coupler(nc)%tag = nm*100*1000 + compid*1000 + nn
+                       prism_coupler(nc)%getput = OASIS3_PUT
+                    elseif (flag == OASIS_In) then
+                       prism_coupler(nc)%tag = compid*100*1000 + nm*1000 + nn
+                       prism_coupler(nc)%getput = OASIS3_GET
+                    endif
+                    !--------------------------------
+                    ! prism_coupler router
+                    ! cannot reuse router because don't really know what's on the other side
+                    !--------------------------------
+                    if (prism_coupler(nc)%nflds == 1) prism_nrouter = prism_nrouter + 1
+                    if (prism_nrouter > prism_mrouter) then
+                       write(nulprt,*) subname,' ERROR prism_nrouter too large',prism_nrouter,&
+                                       prism_mrouter
+                       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                       CALL oasis_flush(nulprt)
+                       call oasis_abort_noarg()
+                    endif
+                    prism_coupler(nc)%routerID = prism_nrouter
+                 endif
+
+                 !--------------------------------
+                 ! prism_coupler mapper
+                 !--------------------------------
+
+                 IF (OASIS_debug >= 20) THEN
+                     WRITE(nulprt,*) subname,' mapper '
+                     CALL oasis_flush(nulprt)
+                 ENDIF
+
+                 tmp_mapfile = nammapfil(nn)
+
+                 if (trim(tmp_mapfile) == 'idmap' .and. trim(namscrmet(nn)) /= trim(cspval)) then
+                    if (trim(namscrmet(nn)) == 'CONSERV') then
+                       tmp_mapfile = 'rmp_'//trim(namsrcgrd(nn))//'_to_'//trim(namdstgrd(nn))//&
+                                     &'_'//trim(namscrmet(nn))//'_'//trim(namscrnor(nn))//'.nc'
+                    else
+                       tmp_mapfile = 'rmp_'//trim(namsrcgrd(nn))//'_to_'//trim(namdstgrd(nn))//&
+                                     &'_'//trim(namscrmet(nn))//'.nc'
+                    endif
+                 endif
+
+                 if (trim(tmp_mapfile) /= 'idmap') then
+                 prism_coupler(nc)%maploc = trim(nammaploc(nn))
+                 if ((flag == OASIS_In  .and. trim(nammaploc(nn)) == 'dst') .or. &
+                     (flag == OASIS_Out .and. trim(nammaploc(nn)) == 'src')) then
+                    !--------------------------------
+                    ! try to reuse mapper already defined
+                    ! must match mapping file and partition
+                    !--------------------------------
+                    mapID = -1
+                    do n = 1,prism_nmapper
+                       if (trim(prism_mapper(n)%file) == trim(tmp_mapfile) .and. &
+                           trim(prism_mapper(n)%opt ) == trim(nammapopt(nn))) then
+                          if (flag == OASIS_In  .and. prism_mapper(n)%dpart == part1) mapID = n
+                          if (flag == OASIS_Out .and. prism_mapper(n)%spart == part1) mapID = n
+                       endif
+                    enddo
+                    !--------------------------------
+                    ! or will need a new mapper
+                    !--------------------------------
+                    if (mapID < 1) then
+                       prism_nmapper = prism_nmapper + 1
+                       if (prism_nmapper > prism_mmapper) then
+                          write(nulprt,*) subname,' ERROR prism_nmapper too large',prism_nmapper,&
+                                          prism_mmapper
+                          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                          CALL oasis_flush(nulprt)
+                          call oasis_abort_noarg()
+                       endif
+                       mapID = prism_nmapper
+                       prism_mapper(mapID)%file = trim(tmp_mapfile)
+                       prism_mapper(mapID)%loc  = trim(nammaploc(nn))
+                       prism_mapper(mapID)%opt  = trim(nammapopt(nn))
+                       prism_mapper(mapID)%srcgrid = TRIM(namsrcgrd(nn))
+                       prism_mapper(mapID)%dstgrid = TRIM(namdstgrd(nn))
+                       if (flag == OASIS_In ) prism_mapper(mapID)%dpart = part1
+                       if (flag == OASIS_Out) prism_mapper(mapID)%spart = part1
+                       if (OASIS_debug > 15) then
+                          write(nulprt,*) subname,' DEBUG new mapper for file ',&
+                                          trim(prism_mapper(mapID)%file)
+                          call oasis_flush(nulprt)
+                       endif
+                    endif
+                    prism_coupler(nc)%mapperID = mapID
+                 endif  ! flag and nammaploc match
+                 endif  ! nammapfil
+
+                 !--------------------------------
+                 ! add this coupler to list of prism_var couplers
+                 !--------------------------------
+
+                 prism_var(nv1)%ncpl = prism_var(nv1)%ncpl + 1
+                 prism_var(nv1)%cpl(prism_var(nv1)%ncpl) = nc
+
+              endif  ! other var in this namcouple
+
+           enddo  ! nv
+           enddo  ! nm
+
+        endif  ! my var in this namcouple
+
+     enddo  ! nv1
+  enddo  ! nns
+
+  deallocate(allvar,nallvar,allops)
+
+  if (OASIS_debug >= 20) then
+     write(nulprt,*) ' '
+     write(nulprt,*) subname,' couplers setup'
+     do nc = 1,prism_ncoupler
+!tcx can't write here, something uninitialized???
+!        call prism_coupler_print(nc)
+     enddo
+     write(nulprt,*) ' '
+     call oasis_flush(nulprt)
+  endif
+
+  if (mpi_comm_local == MPI_COMM_NULL) return
+
+  !----------------------------------------------------------
+  ! Initialize coupling infrastructure based on couplers above
+  !----------------------------------------------------------
+
+  call oasis_debug_note(subname//' initialize coupling datatypes')
+
+  do nc = 1,prism_ncoupler
+     if (OASIS_debug >= 5) then
+        write(nulprt,*) subname,' DEBUG ci:initialize coupler ',nc
+        call oasis_flush(nulprt)
+     endif
+
+     namID = prism_coupler(nc)%namID
+     part1 = prism_coupler(nc)%partID
+     mapID = prism_coupler(nc)%mapperID
+
+     if (part1 <= 0) then
+        write(nulprt,*) subname,' ERROR part1 invalid ',part1
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        call oasis_abort_noarg()
+     endif
+
+     !--------------------------------
+     ! initialize avect1
+     !--------------------------------
+
+     gsize = mct_gsmap_gsize(prism_part(part1)%gsmap)
+     lsize = mct_gsmap_lsize(prism_part(part1)%gsmap,mpi_comm_local)
+     if (OASIS_debug >= 15) then
+        write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part1 info ',part1,mapID,gsize,lsize
+        write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part1a',prism_part(part1)%gsmap%ngseg,&
+                                     prism_part(part1)%gsmap%gsize
+        do n1 = 1,prism_part(part1)%gsmap%ngseg
+           write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part1b',n1,&
+                                        prism_part(part1)%gsmap%start(n1),&
+                                        prism_part(part1)%gsmap%length(n1),&
+                                        prism_part(part1)%gsmap%pe_loc(n1)
+        enddo
+        call oasis_flush(nulprt)
+     endif
+     call mct_avect_init(prism_coupler(nc)%avect1,rList=trim(prism_coupler(nc)%fldlist),lsize=lsize)
+     call mct_avect_zero(prism_coupler(nc)%avect1)
+     prism_coupler(nc)%aVon(1) = .true.
+     if (OASIS_debug >= 15) then
+        write(nulprt,*) subname,' DEBUG ci:avect1 initialized '
+        call oasis_flush(nulprt)
+     endif
+
+     !--------------------------------
+     ! compute nflds for this coupling and initialize avcnt and status
+     !--------------------------------
+
+     prism_coupler(nc)%nflds = mct_aVect_nRAttr(prism_coupler(nc)%avect1)
+     allocate(prism_coupler(nc)%status(prism_coupler(nc)%nflds))
+     allocate(prism_coupler(nc)%avcnt (prism_coupler(nc)%nflds))
+     prism_coupler(nc)%avcnt(:) = 0
+     if (prism_coupler(nc)%getput == OASIS3_PUT) prism_coupler(nc)%status = OASIS_COMM_WAIT
+     if (prism_coupler(nc)%getput == OASIS3_GET) prism_coupler(nc)%status = OASIS_COMM_READY
+
+     !--------------------------------
+     ! initialize mapper
+     !--------------------------------
+
+     if (mapID > 0) then
+
+        if (prism_mapper(mapID)%init) then
+           !--------------------------------
+           ! mapper already initialized
+           !--------------------------------
+           if (prism_coupler(nc)%getput == OASIS3_PUT) then
+              part2 = prism_mapper(mapID)%dpart
+           else
+              part2 = prism_mapper(mapID)%spart
+           endif
+           gsize = mct_gsmap_gsize(prism_part(part2)%gsmap)
+        else
+           !--------------------------------
+           ! instantiate mapper
+           ! read/generate mapping file
+           ! read non local grid size
+           ! get gsmap for non local grid
+           ! read mapping weights and initialize sMatP
+           !--------------------------------
+           if (OASIS_debug >= 15) then
+              write(nulprt,*) subname,' DEBUG ci:read mapfile ',trim(prism_mapper(mapID)%file)
+              call oasis_flush(nulprt)
+           endif
+           if (mpi_rank_local == 0) then
+              inquire(file=trim(prism_mapper(mapID)%file),exist=exists)
+              if (OASIS_debug >= 15) then
+                 write(nulprt,*) subname,' DEBUG ci: inquire mapfile',&
+                                 trim(prism_mapper(mapID)%file),exists
+                 call oasis_flush(nulprt)
+              endif
+              if (.not.exists) then
+                 if (trim(namscrmet(namID)) /= trim(cspval)) then
+                    !--------------------------------
+                    ! generate mapping file on root pe
+                    ! taken from oasis3 scriprmp
+                    !--------------------------------
+                    call oasis_coupler_genmap(mapID,namID)
+                 else
+                    write(nulprt,*) subname,' ERROR map file does not exist and SCRIPR not set ',&
+                                    trim(prism_mapper(mapID)%file)
+                    WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                    CALL oasis_flush(nulprt)
+                    call oasis_abort_noarg()
+                 endif
+              endif
+
+              !--------------------------------
+              ! open mapping file
+              !--------------------------------
+              status = nf90_open(trim(prism_mapper(mapID)%file),nf90_nowrite,ncid)
+              if (prism_coupler(nc)%getput == OASIS3_PUT) &
+                 status = nf90_inq_dimid(ncid,'dst_grid_size',dimid)
+              if (prism_coupler(nc)%getput == OASIS3_GET) &
+                 status = nf90_inq_dimid(ncid,'src_grid_size',dimid)
+              status = nf90_inquire_dimension(ncid,dimid,len=gsize)
+           endif
+           call oasis_mpi_bcast(gsize,mpi_comm_local,subname//' gsize')
+
+           if (prism_coupler(nc)%getput == OASIS3_PUT) then
+              nx = namdst_nx(namID)
+              ny = namdst_ny(namID)
+              gridname = trim(namdstgrd(namID))
+           else
+              nx = namsrc_nx(namID)
+              ny = namsrc_ny(namID)
+              gridname = trim(namsrcgrd(namID))
+           endif
+
+           !tcx improve match here with nx,ny,gridname 
+           call oasis_part_create(part2,'1d',gsize,nx,ny,gridname)
+
+           if (prism_part(part2)%nx < 1) then
+              prism_part(part2)%nx = nx
+              prism_part(part2)%ny = ny
+              prism_part(part2)%gridname = trim(gridname)
+           endif
+
+           if (prism_coupler(nc)%getput == OASIS3_PUT) then
+             !prism_mapper(mapID)%spart = part1   ! set above
+              prism_mapper(mapID)%dpart = part2
+           else
+              prism_mapper(mapID)%spart = part2
+             !prism_mapper(mapID)%dpart = part1   ! set above
+           endif
+           spart = prism_mapper(mapID)%spart
+           dpart = prism_mapper(mapID)%dpart
+
+           !--- cstring sets whether src or dst are rearranged in remap
+           !--- src = rearrange and map (bfb), dst = map and rearrange (partial sum)
+           if (prism_mapper(mapID)%opt == 'opt') then
+              if (prism_part(spart)%gsize > prism_part(dpart)%gsize) then
+                 cstring = 'dst'
+              else
+                 cstring = 'src'
+              endif
+           elseif (prism_mapper(mapID)%opt == 'bfb') then
+              cstring = 'src'
+           elseif (prism_mapper(mapID)%opt == 'sum') then
+              cstring = 'dst'
+           else
+              write(nulprt,*) subname,' ERROR mapper opt invalid ',trim(prism_mapper(mapID)%opt)
+              WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+              CALL oasis_flush(nulprt)
+              call oasis_abort_noarg()
+           endif
+           if (prism_mapper(mapID)%optval /= '' .and. &
+               prism_mapper(mapID)%optval /= trim(cstring)) then
+              write(nulprt,*) subname,' ERROR mapper opt changed',&
+                              trim(prism_mapper(mapID)%optval),' ',trim(cstring)
+              WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+              CALL oasis_flush(nulprt)
+              call oasis_abort_noarg()
+           endif
+           prism_mapper(mapID)%optval = trim(cstring)
+
+           !call oasis_timer_start('cpl_smatrd')
+           !-------------------------------
+           ! smatreaddnc allocates sMati to nwgts
+           ! then instantiate an sMatP for each set of wgts
+           ! to support higher order mapping
+           !-------------------------------
+           call oasis_coupler_smatreaddnc(sMati,prism_part(spart)%gsmap,prism_part(dpart)%gsmap, &
+              trim(cstring),trim(prism_mapper(mapID)%file),mpi_rank_local,mpi_comm_local, &
+              nwgts)
+           prism_mapper(mapID)%nwgts = nwgts
+           allocate(prism_mapper(mapID)%sMatP(nwgts))
+           do n = 1,nwgts
+              call mct_sMatP_Init(prism_mapper(mapID)%sMatP(n), sMati(n), &
+                 prism_part(spart)%gsmap, prism_part(dpart)%gsmap, 0, mpi_comm_local, compid)
+              call mct_sMat_Clean(sMati(n))
+           enddo
+           deallocate(sMati)
+           !call oasis_timer_stop('cpl_smatrd')
+
+           lsize = mct_smat_gNumEl(prism_mapper(mapID)%sMatP(1)%Matrix,mpi_comm_local)
+           prism_mapper(mapID)%init = .true.
+           if (OASIS_debug >= 15) then
+              write(nulprt,*) subname," DEBUG ci:done initializing prism_mapper",mapID,&
+                              " nElements = ",lsize," nwgts = ",nwgts
+              call oasis_flush(nulprt)
+           endif
+        endif  ! map init
+
+        !--------------------------------
+        ! read mapper mask and area if not already done
+        !--------------------------------
+        if (.not.prism_mapper(mapID)%AVred .and. prism_coupler(nc)%conserv /= ip_cnone) then
+           ! initialize and load AV_ms and AV_md
+
+           spart = prism_mapper(mapID)%spart
+           dpart = prism_mapper(mapID)%dpart
+
+           lsize = mct_gsmap_lsize(prism_part(spart)%gsmap,mpi_comm_local)
+           call mct_avect_init(prism_mapper(mapID)%av_ms,iList='mask',rList='area',lsize=lsize)
+           call mct_avect_zero(prism_mapper(mapID)%av_ms)
+!           gridname = prism_part(spart)%gridname
+           gridname=prism_mapper(mapID)%srcgrid
+           call oasis_io_read_avfld('masks.nc',prism_mapper(mapID)%av_ms, &
+              prism_part(spart)%gsmap,'mask',trim(gridname)//'.msk',fldtype='int')
+           call oasis_io_read_avfld('areas.nc',prism_mapper(mapID)%av_ms, &
+              prism_part(spart)%gsmap,'area',trim(gridname)//'.srf',fldtype='real')
+
+           lsize = mct_gsmap_lsize(prism_part(dpart)%gsmap,mpi_comm_local)
+           call mct_avect_init(prism_mapper(mapID)%av_md,iList='mask',rList='area',lsize=lsize)
+           call mct_avect_zero(prism_mapper(mapID)%av_md)
+!           gridname = prism_part(dpart)%gridname
+           gridname=prism_mapper(mapID)%dstgrid
+           call oasis_io_read_avfld('masks.nc',prism_mapper(mapID)%av_md, &
+              prism_part(dpart)%gsmap,'mask',trim(gridname)//'.msk',fldtype='int')
+           call oasis_io_read_avfld('areas.nc',prism_mapper(mapID)%av_md, &
+              prism_part(dpart)%gsmap,'area',trim(gridname)//'.srf',fldtype='real')
+
+           prism_mapper(mapID)%AVred = .true.
+
+           if (OASIS_debug >= 30) then
+              write(nulprt,*) subname,' DEBUG msi ',minval(prism_mapper(mapID)%av_ms%iAttr(:,:)),&
+                              maxval(prism_mapper(mapID)%av_ms%iAttr(:,:)),&
+                              sum(prism_mapper(mapID)%av_ms%iAttr(:,:))
+              write(nulprt,*) subname,' DEBIG msr ',minval(prism_mapper(mapID)%av_ms%rAttr(:,:)),&
+                              maxval(prism_mapper(mapID)%av_ms%rAttr(:,:)),&
+                              sum(prism_mapper(mapID)%av_ms%rAttr(:,:))
+              write(nulprt,*) subname,' DEBUG mdi ',minval(prism_mapper(mapID)%av_md%iAttr(:,:)),&
+                              maxval(prism_mapper(mapID)%av_md%iAttr(:,:)),&
+                              sum(prism_mapper(mapID)%av_md%iAttr(:,:))
+              write(nulprt,*) subname,' DEBUG mdr ',minval(prism_mapper(mapID)%av_md%rAttr(:,:)),&
+                              maxval(prism_mapper(mapID)%av_md%rAttr(:,:)),&
+                              sum(prism_mapper(mapID)%av_md%rAttr(:,:))
+              CALL oasis_flush(nulprt)
+           endif
+        endif
+
+        !--------------------------------
+        ! initialize avect1m
+        !--------------------------------
+
+        lsize = mct_gsmap_lsize(prism_part(part2)%gsmap,mpi_comm_local)
+        if (OASIS_debug >= 15) then
+           write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part2 info ',part2,mapID,gsize,lsize
+           write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part2a',prism_part(part2)%gsmap%ngseg,&
+                                        prism_part(part2)%gsmap%gsize
+           do n1 = 1,prism_part(part2)%gsmap%ngseg
+              write(nulprt,'(1x,2a,4i12)') subname,' DEBUG ci:part2b',n1,prism_part(part2)%gsmap%start(n1),&
+                                           prism_part(part2)%gsmap%length(n1),prism_part(part2)%gsmap%pe_loc(n1)
+           enddo
+           call oasis_flush(nulprt)
+        endif
+        call mct_avect_init(prism_coupler(nc)%avect1m,rList=trim(prism_coupler(nc)%fldlist),lsize=lsize)
+        call mct_avect_zero(prism_coupler(nc)%avect1m)
+        if (OASIS_debug >= 15) then
+           write(nulprt,*) subname,' DEBUG ci:avect1m initialized '
+           call oasis_flush(nulprt)
+        endif
+
+        !--------------------------------
+        ! router partition is always other part
+        !--------------------------------
+
+        rpart = part2
+
+     else
+
+        !--------------------------------
+        ! router partition is just coupler part
+        !--------------------------------
+
+        rpart = prism_coupler(nc)%partID
+
+     endif  ! no mapper
+
+     !--------------------------------
+     ! initialize router based on rpart
+     !--------------------------------
+
+     if (prism_coupler(nc)%sndrcv) then
+
+        if (OASIS_debug >= 15) then
+           write(nulprt,*) subname,' DEBUG ci:initialize router ',prism_coupler(nc)%routerID,&
+                           prism_coupler(nc)%comp,rpart
+           call oasis_flush(nulprt)
+        endif
+
+        call mct_router_init(prism_coupler(nc)%comp,prism_part(rpart)%gsmap, &
+           mpi_comm_local,prism_router(prism_coupler(nc)%routerID)%router)
+
+        if (OASIS_debug >= 15) then
+           write(nulprt,*) subname," DEBUG ci:done initializing prism_router",&
+                           prism_coupler(nc)%routerID
+           call oasis_flush(nulprt)
+        endif
+     endif
+
+  enddo
+
+  !----------------------------------------------------------
+  ! Diagnostics
+  !----------------------------------------------------------
+
+  if (OASIS_debug >= 2) then
+     write(nulprt,*) ' '
+     write(nulprt,*) subname,' couplers initialized'
+     do nc = 1,prism_ncoupler
+        call oasis_coupler_print(nc)
+     enddo
+     write(nulprt,*) ' '
+     CALL oasis_flush(nulprt)
+  endif
+
+  call oasis_timer_stop('cpl_setup')
+
+  call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_coupler_setup
+
+!------------------------------------------------------------
+  SUBROUTINE oasis_coupler_print(cplid)
+
+  IMPLICIT NONE
+
+  integer(ip_i4_p), intent(in) :: cplid
+  !----------------------------------------------------------
+  integer(ip_i4_p) :: mapid, rouid, parid, namid, nflds
+  integer(ip_i4_p) :: spart,dpart
+  character(len=*),parameter :: subname = 'oasis_coupler_print'
+
+  call oasis_debug_enter(subname)
+
+  mapid = prism_coupler(cplid)%mapperid
+  rouid = prism_coupler(cplid)%routerid
+  parid = prism_coupler(cplid)%partid
+  namid = prism_coupler(cplid)%namid
+  nflds = prism_coupler(cplid)%nflds
+
+     write(nulprt,*) ' '
+     write(nulprt,*) subname,' model and cplid   ',compid,cplid
+  if (prism_coupler(cplid)%getput == OASIS3_PUT) then
+     write(nulprt,*) subname,'   send fields     ',trim(prism_coupler(cplid)%fldlist)
+     write(nulprt,*) subname,'   from model      ',compid
+     write(nulprt,*) subname,'   to model        ',prism_coupler(cplid)%comp
+     write(nulprt,*) subname,'   using router    ',rouid
+     write(nulprt,*) subname,'   transform       ',prism_coupler(cplid)%trans
+     write(nulprt,*) subname,'   snd diagnose    ',prism_coupler(cplid)%snddiag
+     write(nulprt,*) subname,'   snd fld mult    ',prism_coupler(cplid)%sndmult
+     write(nulprt,*) subname,'   snd fld add     ',prism_coupler(cplid)%sndadd
+  endif
+  if (prism_coupler(cplid)%getput == OASIS3_GET) then
+     write(nulprt,*) subname,'   recv fields      ',trim(prism_coupler(cplid)%fldlist)
+     write(nulprt,*) subname,'   from model       ',prism_coupler(cplid)%comp
+     write(nulprt,*) subname,'   to model         ',compid
+     write(nulprt,*) subname,'   using router     ',rouid
+     write(nulprt,*) subname,'   rcv diagnose     ',prism_coupler(cplid)%rcvdiag
+     write(nulprt,*) subname,'   rcv fld mult     ',prism_coupler(cplid)%rcvmult
+     write(nulprt,*) subname,'   rcv fld add      ',prism_coupler(cplid)%rcvadd
+  endif
+     write(nulprt,*) subname,'   namcouple op     ',prism_coupler(cplid)%ops
+     write(nulprt,*) subname,'   namcouple id     ',namid
+     write(nulprt,*) subname,'   variable ids     ',prism_coupler(cplid)%varid(1:nflds)
+     write(nulprt,*) subname,'   sndrcv flag      ',prism_coupler(cplid)%sndrcv
+     write(nulprt,*) subname,'   output flag      ',prism_coupler(cplid)%output
+     write(nulprt,*) subname,'   input flag       ',prism_coupler(cplid)%input
+     write(nulprt,*) subname,'   input file       ',trim(prism_coupler(cplid)%inpfile)
+     write(nulprt,*) subname,'   restart file     ',trim(prism_coupler(cplid)%rstfile)
+     write(nulprt,*) subname,'   tag              ',prism_coupler(cplid)%tag
+     write(nulprt,*) subname,'   seq              ',prism_coupler(cplid)%seq
+     write(nulprt,*) subname,'   maxtime          ',prism_coupler(cplid)%maxtime
+     write(nulprt,*) subname,'   dt, lag          ',prism_coupler(cplid)%dt,prism_coupler(cplid)%lag
+     write(nulprt,*) subname,'   partid, size     ',parid,trim(prism_part(parid)%gridname),&
+                                                    prism_part(parid)%gsize
+     write(nulprt,*) subname,'   partid, nx,ny    ',prism_part(parid)%nx,prism_part(parid)%ny
+     write(nulprt,*) subname,'   maploc           ',trim(prism_coupler(cplid)%maploc)
+
+  if (mapid > 0) then
+     WRITE(nulprt,*) subname,'   Source mask      ',trim(prism_mapper(mapid)%srcgrid)
+     WRITE(nulprt,*) subname,'   Target mask      ',trim(prism_mapper(mapid)%dstgrid)
+     write(nulprt,*) subname,'   use map          ',mapid,trim(prism_mapper(mapid)%file)
+     write(nulprt,*) subname,'   nwgts            ',mapid,prism_mapper(mapid)%nwgts
+     spart = prism_mapper(mapid)%spart
+     dpart = prism_mapper(mapid)%dpart
+     write(nulprt,*) subname,'   conserve         ',prism_coupler(cplid)%conserv
+     write(nulprt,*) subname,'   conserve opt     ',prism_coupler(cplid)%consopt
+     write(nulprt,*) subname,'   location         ',trim(prism_mapper(mapid)%loc)
+     write(nulprt,*) subname,'   opt,optval       ',trim(prism_mapper(mapid)%opt),' ',&
+                                                    trim(prism_mapper(mapid)%optval)
+     write(nulprt,*) subname,'   s/d partids      ',spart,dpart
+     if (spart > 0) &
+     write(nulprt,*) subname,'   from/to part     ',trim(prism_part(spart)%gridname),' ',&
+                                                    trim(prism_part(dpart)%gridname)
+     write(nulprt,*) subname,'   from nx,ny       ',prism_part(spart)%gsize,prism_part(spart)%nx,&
+                                                    prism_part(spart)%ny
+     if (dpart > 0) &
+     write(nulprt,*) subname,'   to nx,ny         ',prism_part(dpart)%gsize, prism_part(dpart)%nx,&
+                                                    prism_part(dpart)%ny
+  endif
+
+  call oasis_flush(nulprt)
+
+  call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_coupler_print
+
+!------------------------------------------------------------
+  SUBROUTINE oasis_coupler_genmap(mapid,namid)
+
+  IMPLICIT NONE
+
+  integer(ip_i4_p), intent(in) :: mapid
+  integer(ip_i4_p), intent(in) :: namid
+  !----------------------------------------------------------
+
+  integer(ip_i4_p)              :: src_size,src_rank, ncrn_src
+  integer(ip_i4_p) ,allocatable :: src_dims(:),src_mask(:)
+  real(ip_double_p),allocatable :: src_lon(:),src_lat(:)
+  real(ip_double_p),allocatable :: src_corner_lon(:,:),src_corner_lat(:,:)
+  integer(ip_i4_p)              :: dst_size,dst_rank, ncrn_dst
+  integer(ip_i4_p) ,allocatable :: dst_dims(:),dst_mask(:)
+  real(ip_double_p),allocatable :: dst_lon(:),dst_lat(:)
+  real(ip_double_p),allocatable :: dst_corner_lon(:,:),dst_corner_lat(:,:)
+  integer(ip_i4_p) ,allocatable :: ifld2(:,:)
+  real(ip_double_p),allocatable :: fld2(:,:),fld3(:,:,:)
+  integer(ip_i4_p) :: i,j,k,icnt,nx,ny,nc
+  logical :: lextrapdone
+  logical :: do_corners
+  character(len=ic_med) :: filename
+  character(len=ic_med) :: fldname
+  character(len=*),parameter :: subname = 'oasis_coupler_genmap'
+
+  call oasis_debug_enter(subname)
+
+  lextrapdone = .false.
+  nx = -1  ! must be read
+  ny = -1  ! must be read
+  nc =  1  ! might not be read, set to something reasonable
+
+  !--- checks first ---
+
+  if (trim(namscrtyp(namID)) /= 'SCALAR') then
+     write(nulprt,*) subname,' ERROR: only scrip type SCALAR mapping supported'
+     WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+     CALL oasis_flush(nulprt)
+     CALL oasis_abort_noarg()
+  endif
+
+  
+  do_corners = .false.
+  if (trim(namscrmet(namID)) == 'CONSERV') then
+     do_corners = .true.
+  endif
+
+  !--- src data ---
+
+  filename = 'grids.nc'
+  if (do_corners) then
+     fldname = trim(namsrcgrd(namID))//'.clo'
+     call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny,nz=nc)
+  else
+     fldname = trim(namsrcgrd(namID))//'.lon'
+     call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny)
+  endif
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',&
+                                         trim(fldname),nx,ny,nc,do_corners
+  src_rank = 2
+  src_size = nx*ny
+  allocate(src_dims(src_rank))
+  src_dims(1) = nx
+  src_dims(2) = ny
+  ncrn_src = nc
+  allocate(src_mask(src_size))
+  allocate(src_lon (src_size))
+  allocate(src_lat (src_size))
+  allocate(src_corner_lon(ncrn_src,src_size))
+  allocate(src_corner_lat(ncrn_src,src_size))
+
+  allocate(ifld2(nx,ny))
+  filename = 'masks.nc'
+  fldname = trim(namsrcgrd(namID))//'.msk'
+  call oasis_io_read_field_fromroot(filename,fldname,ifld2=ifld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     src_mask(icnt) = ifld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(src_mask),maxval(src_mask)
+  deallocate(ifld2)
+
+  allocate(fld2(nx,ny))
+  filename = 'grids.nc'
+  fldname = trim(namsrcgrd(namID))//'.lon'
+  call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     src_lon(icnt) = fld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(src_lon),maxval(src_lon)
+  fldname = trim(namsrcgrd(namID))//'.lat'
+  call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     src_lat(icnt) = fld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(src_lat),maxval(src_lat)
+  deallocate(fld2)
+
+  if (do_corners) then
+     allocate(fld3(nx,ny,nc))
+     filename = 'grids.nc'
+     fldname = trim(namsrcgrd(namID))//'.clo'
+     call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
+     icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+        do k = 1,nc
+           src_corner_lon(k,icnt) = fld3(i,j,k)
+        enddo
+     enddo; enddo
+     if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+        minval(src_corner_lon),maxval(src_corner_lon)
+     fldname = trim(namsrcgrd(namID))//'.cla'
+     call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
+     icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+        do k = 1,nc
+           src_corner_lat(k,icnt) = fld3(i,j,k)
+        enddo
+     enddo; enddo
+     if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+        minval(src_corner_lat),maxval(src_corner_lat)
+     deallocate(fld3)
+  else
+     src_corner_lon = -9999.
+     src_corner_lat = -9999.
+  endif
+
+  !--- dst data ---
+
+  filename = 'grids.nc'
+  if (do_corners) then
+     fldname = trim(namdstgrd(namID))//'.clo'
+     call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny,nz=nc)
+  else
+     fldname = trim(namdstgrd(namID))//'.lon'
+     call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny)
+  endif
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname),nx,ny,nc
+  dst_rank = 2
+  dst_size = nx*ny
+  allocate(dst_dims(dst_rank))
+  dst_dims(1) = nx
+  dst_dims(2) = ny
+  ncrn_dst = nc
+  allocate(dst_mask(dst_size))
+  allocate(dst_lon (dst_size))
+  allocate(dst_lat (dst_size))
+  allocate(dst_corner_lon(ncrn_dst,dst_size))
+  allocate(dst_corner_lat(ncrn_dst,dst_size))
+
+  allocate(ifld2(nx,ny))
+  filename = 'masks.nc'
+  fldname = trim(namdstgrd(namID))//'.msk'
+  call oasis_io_read_field_fromroot(filename,fldname,ifld2=ifld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     dst_mask(icnt) = ifld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(dst_mask),maxval(dst_mask)
+  deallocate(ifld2)
+
+  allocate(fld2(nx,ny))
+  filename = 'grids.nc'
+  fldname = trim(namdstgrd(namID))//'.lon'
+  call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     dst_lon(icnt) = fld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(dst_lon),maxval(dst_lon)
+  fldname = trim(namdstgrd(namID))//'.lat'
+  call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
+  icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+     dst_lat(icnt) = fld2(i,j)
+  enddo; enddo
+  if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+     minval(dst_lat),maxval(dst_lat)
+  deallocate(fld2)
+
+  if (do_corners) then
+     allocate(fld3(nx,ny,nc))
+     filename = 'grids.nc'
+     fldname = trim(namdstgrd(namID))//'.clo'
+     call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
+     icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+        do k = 1,nc
+           dst_corner_lon(k,icnt) = fld3(i,j,k)
+        enddo
+     enddo; enddo
+     if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+        minval(dst_corner_lon),maxval(dst_corner_lon)
+     fldname = trim(namdstgrd(namID))//'.cla'
+     call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
+     icnt = 0; do j = 1,ny; do i = 1,nx; icnt = icnt + 1
+        do k = 1,nc
+           dst_corner_lat(k,icnt) = fld3(i,j,k)
+        enddo
+     enddo; enddo
+     if (OASIS_debug >= 15) write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname), &
+        minval(dst_corner_lat),maxval(dst_corner_lat)
+     deallocate(fld3)
+  else
+     dst_corner_lon = -9999.
+     dst_corner_lat = -9999.
+  endif
+
+  IF (OASIS_debug >= 15) THEN
+      WRITE(nulprt,*) subname,' call grid_init '
+      CALL oasis_flush(nulprt)
+  ENDIF
+
+  !--- 0/1 mask convention opposite in scrip vs oasis
+  src_mask = 1 - src_mask
+  dst_mask = 1 - dst_mask
+  call grid_init(namscrmet(namID),namscrres(namID),namscrbin(namID),  &
+       src_size, dst_size, src_dims, dst_dims, &
+       src_rank, dst_rank, ncrn_src, ncrn_dst, &
+       src_mask, dst_mask, namsrcgrd(namID), namdstgrd(namID), &
+       src_lat,  src_lon,  dst_lat,  dst_lon, &
+       src_corner_lat, src_corner_lon, &
+       dst_corner_lat, dst_corner_lon, &
+       logunit=nulprt)
+  if (OASIS_debug >= 15) then
+      WRITE(nulprt,*) subname,' done grid_init '
+      CALL oasis_flush(nulprt)
+  ENDIF
+
+  IF (OASIS_debug >= 15) THEN
+      WRITE(nulprt,*) subname,' call scrip '
+      CALL oasis_flush(nulprt)
+  ENDIF
+  call scrip(prism_mapper(mapid)%file,prism_mapper(mapid)%file,namscrmet(namID), &
+             namscrnor(namID),lextrapdone,namscrvam(namID),namscrnbr(namID))
+  IF (OASIS_debug >= 15) THEN
+      WRITE(nulprt,*) subname,' done scrip '
+      CALL oasis_flush(nulprt)
+  ENDIF
+
+  deallocate(src_dims, dst_dims)
+  deallocate(src_mask)
+  deallocate(src_lon)
+  deallocate(src_lat)
+  deallocate(src_corner_lon)
+  deallocate(src_corner_lat)
+  deallocate(dst_mask)
+  deallocate(dst_lon)
+  deallocate(dst_lat)
+  deallocate(dst_corner_lon)
+  deallocate(dst_corner_lat)
+
+
+  call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_coupler_genmap
+
+!------------------------------------------------------------
+
+!BOP ===========================================================================
+!
+! !IROUTINE:  oasis_coupler_sMatReaddnc - Do a distributed read of a NetCDF SCRIP file and
+!                                return weights in a distributed SparseMatrix
+!
+! !DESCRIPTION: 
+!     Read in mapping matrix data from a SCRIP netCDF data file using
+!     a low memory method and then scatter to all pes.  Based on 
+!     oasis_coupler_sMatReaddnc from CESM1.0.3
+!
+! !REMARKS:
+!   This routine leverages gsmaps to determine scatter pattern
+!   The scatter is implemented as a bcast of all weights then a local
+!     computation on each pe to determine with weights to keep based
+!     on gsmap information.
+!   The algorithm to determine whether a weight belongs on a pe involves
+!     creating a couple local arrays (lsstart and lscount) which are
+!     the local values of start and length from the gsmap.  these are
+!     sorted via a bubble sort and then searched via a binary search
+!     to check whether a global index is on the local pe.
+!   The local buffer sizes are estimated up front based on ngridcell/npes
+!     plus 20% (see 1.2 below).  If the local buffer size fills up, then
+!     the buffer is reallocated 50% large (see 1.5 below) and the fill
+!     continues.  The idea is to trade off memory reallocation and copy
+!     with memory usage.  1.2 and 1.5 are arbitary, other values may
+!     result in better performance.
+!   Once all the matrix weights have been read, the sMat is initialized,
+!     the values from the buffers are copied in, and everything is deallocated.
+!
+! !INTERFACE:  -----------------------------------------------------------------
+
+subroutine oasis_coupler_sMatReaddnc(sMat,SgsMap,DgsMap,newdom, &
+                            fileName,mytask,mpicom,nwgts, &
+                            areasrc,areadst,ni_i,nj_i,ni_o,nj_o )
+
+! !USES:
+
+   !--- local kinds ---
+   integer,parameter :: R8 = ip_double_p
+   integer,parameter :: IN = ip_i4_p
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   type(mct_sMat)  ,intent(out),pointer   :: sMat(:) ! mapping data
+   type(mct_gsMap) ,intent(in) ,target    :: SgsMap  ! src gsmap
+   type(mct_gSMap) ,intent(in) ,target    :: DgsMap  ! dst gsmap
+   character(*)    ,intent(in)            :: newdom  ! type of sMat (src or dst)
+        ! src = rearrange and map (bfb), dst = map and rearrange (partial sums)
+   character(*)    ,intent(in)            :: filename! netCDF file to read
+   integer(IN)     ,intent(in)            :: mytask   ! processor id
+   integer(IN)     ,intent(in)            :: mpicom  ! communicator
+   integer(IN)     ,intent(out)           :: nwgts   ! number of weights 
+   type(mct_Avect) ,intent(out), optional :: areasrc ! area of src grid from mapping file
+   type(mct_Avect) ,intent(out), optional :: areadst ! area of dst grid from mapping file
+   integer(IN)     ,intent(out), optional :: ni_i    ! number of lons on input grid   
+   integer(IN)     ,intent(out), optional :: nj_i    ! number of lats on input grid   
+   integer(IN)     ,intent(out), optional :: ni_o    ! number of lons on output grid   
+   integer(IN)     ,intent(out), optional :: nj_o    ! number of lats on output grid   
+
+! !EOP
+
+   !--- local ---
+   integer           :: n,m     ! generic loop indicies
+   integer           :: na      ! size of source domain
+   integer           :: nb      ! size of destination domain
+   integer           :: ns      ! number of non-zero elements in matrix
+   integer           :: ni,nj   ! number of row and col in the matrix
+   integer           :: igrow   ! aVect index for matrix row
+   integer           :: igcol   ! aVect index for matrix column
+   integer           :: iwgt    ! aVect index for matrix element
+   integer           :: iarea   ! aVect index for area
+   integer           :: rsize   ! size of read buffer
+   integer           :: cnt     ! local num of wgts
+   integer           :: cntold  ! local num of wgts, previous read
+   integer           :: start(1)! netcdf read
+   integer           :: count(1)! netcdf read
+   integer           :: start2(2)! netcdf read
+   integer           :: count2(2)! netcdf read
+   integer           :: bsize   ! buffer size
+   integer           :: nread   ! number of reads 
+   logical           :: mywt    ! does this weight belong on my pe
+   integer           :: dims(2) 
+
+   !--- buffers for i/o ---
+   real(R8)   ,allocatable :: rtemp(:) ! real temporary
+   real(R8)   ,allocatable :: Sbuf(:,:)  ! real weights
+   real(R8)   ,allocatable :: remaps(:,:)  ! real weights with num_wgts dim
+   integer,allocatable :: Rbuf(:)  ! ints rows
+   integer,allocatable :: Cbuf(:)  ! ints cols
+
+   !--- variables associated with local computation of global indices
+   integer             :: lsize     ! size of local seg map
+   integer             :: commsize  ! size of local communicator
+   integer,allocatable :: lsstart(:) ! local seg map info
+   integer,allocatable :: lscount(:) ! local seg map info
+   type(mct_gsMap),pointer :: mygsmap ! pointer to one of the gsmaps
+   integer             :: l1,l2     ! generice indices for sort
+   logical             :: found     ! for sort
+
+   !--- variable assocaited with local data buffers and reallocation
+   real(R8)   ,allocatable :: Snew(:,:),Sold(:,:)  ! reals
+   integer,allocatable :: Rnew(:),Rold(:)  ! ints
+   integer,allocatable :: Cnew(:),Cold(:)  ! ints
+
+   character,allocatable :: str(:)  ! variable length char string
+   character(len=ic_long):: attstr  ! netCDF attribute name string
+   integer           :: status   ! netCDF routine return code
+   integer           :: fid     ! netCDF file      ID
+   integer           :: vid     ! netCDF variable  ID
+   integer           :: did     ! netCDF dimension ID
+   !--- arbitrary size of read buffer, this is the chunk size weights reading
+   integer,parameter :: rbuf_size = 100000
+
+   !--- global source and destination areas ---
+   type(mct_Avect) :: areasrc0   ! area of src grid from mapping file
+   type(mct_Avect) :: areadst0   ! area of src grid from mapping file
+
+   character(*),parameter :: areaAV_field = 'aream'
+
+   !--- formats ---
+   character(*),parameter :: subName = 'oasis_coupler_sMatReaddnc'
+   character(*),parameter :: F00 = '("oasis_coupler_sMatReaddnc",1x,4a)'
+   character(*),parameter :: F01 = '("oasis_coupler_sMatReaddnc",1x,2(a,i10))'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+ call oasis_debug_enter(subname)
+ call oasis_mpi_commsize(mpicom,commsize)
+ nwgts = -1
+ if (mytask == 0) then
+   if (OASIS_debug >= 2) write(nulprt,F00) "reading mapping matrix data decomposed..."
+
+   !----------------------------------------------------------------------------
+   ! open & read the file
+   !----------------------------------------------------------------------------
+   if (OASIS_debug >=2 ) write(nulprt,F00) "* file name                  : ",trim(fileName)
+   status = nf90_open(trim(filename),NF90_NOWRITE,fid)
+   if (status /= NF90_NOERR) then
+      write(nulprt,F00) trim(nf90_strerror(status))
+      WRITE(nulprt,*) subname,'ERROR filename'
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   !--- get matrix dimensions ----------
+!  status = nf90_inq_dimid (fid, 'n_s', did)  ! size of sparse matrix
+   status = nf90_inq_dimid (fid, 'num_links', did)  ! size of sparse matrix
+   status = nf90_inquire_dimension(fid, did  , len = ns)
+!  status = nf90_inq_dimid (fid, 'n_a', did)  ! size of  input vector
+   status = nf90_inq_dimid (fid, 'src_grid_size', did)  ! size of  input vector
+   status = nf90_inquire_dimension(fid, did  , len = na)
+!  status = nf90_inq_dimid (fid, 'n_b', did)  ! size of output vector
+   status = nf90_inq_dimid (fid, 'dst_grid_size', did)  ! size of output vector
+   status = nf90_inquire_dimension(fid, did  , len = nb)
+   status = nf90_inq_dimid (fid, 'num_wgts', did)  ! size of output vector
+   status = nf90_inquire_dimension(fid, did  , len = nwgts)
+   
+   if (present(ni_i) .and. present(nj_i) .and. present(ni_o) .and. present(nj_o)) then
+!     status = nf90_inq_dimid (fid, 'ni_a', did)  ! number of lons in input grid
+!     status = nf90_inquire_dimension(fid, did  , len = ni_i)
+!     status = nf90_inq_dimid (fid, 'nj_a', did)  ! number of lats in input grid
+!     status = nf90_inquire_dimension(fid, did  , len = nj_i)
+!     status = nf90_inq_dimid (fid, 'ni_b', did)  ! number of lons in output grid
+!     status = nf90_inquire_dimension(fid, did  , len = ni_o)
+!     status = nf90_inq_dimid (fid, 'nj_b', did)  ! number of lats in output grid
+!     status = nf90_inquire_dimension(fid, did  , len = nj_o)
+      status = nf90_inq_varid(fid, 'src_grid_dims', vid)
+      status = nf90_get_var(fid, vid, dims)
+      ni_i = dims(1)
+      nj_i = dims(2)
+      status = nf90_inq_varid(fid, 'dst_grid_dims', vid)
+      status = nf90_get_var(fid, vid, dims)
+      ni_o = dims(1)
+      nj_o = dims(2)
+   end if
+
+   if (OASIS_debug >= 2) write(nulprt,F01) "* matrix dims src x dst      : ",na,' x',nb
+   if (OASIS_debug >= 2) write(nulprt,F01) "* number of non-zero elements: ",ns
+
+ endif
+ 
+   !--- read and load area_a ---
+   if (present(areasrc)) then
+   if (mytask == 0) then
+      call mct_aVect_init(areasrc0,' ',areaAV_field,na)
+!     status = nf90_inq_varid     (fid,'area_a',vid)
+      status = nf90_inq_varid     (fid,'src_grid_area',vid)
+      IF (status /= NF90_NOERR) THEN
+          WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+          WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+      ENDIF
+      status = nf90_get_var(fid, vid, areasrc0%rAttr)
+      IF (status /= NF90_NOERR) THEN
+          WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+          WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+      ENDIF
+   endif
+   call mct_aVect_scatter(areasrc0, areasrc, SgsMap, 0, mpicom, status)
+   if (status /= 0) call mct_die(subname,"Error on scatter of areasrc0")
+   if (mytask == 0) then
+!      if (present(dbug)) then
+!         if (dbug > 2) then
+!            write(nulprt,*) subName,'Size of src ',mct_aVect_lSize(areasrc0)
+!            write(nulprt,*) subName,'min/max src ',minval(areasrc0%rAttr(1,:)),maxval(areasrc0%rAttr(1,:))
+!         endif
+!      end if
+      call mct_aVect_clean(areasrc0)
+   end if
+   end if
+
+   !--- read and load area_b ---
+   if (present(areadst)) then
+   if (mytask == 0) then
+      call mct_aVect_init(areadst0,' ',areaAV_field,nb)
+!     status = nf90_inq_varid     (fid,'area_b',vid)
+      status = nf90_inq_varid     (fid,'dst_grid_area',vid)
+      IF (status /= NF90_NOERR) THEN
+          WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+          WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+      ENDIF
+      status = nf90_get_var(fid, vid, areadst0%rAttr)
+      IF (status /= NF90_NOERR) THEN
+          WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+          WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+      ENDIF
+   endif
+   call mct_aVect_scatter(areadst0, areadst, DgsMap, 0, mpicom, status)
+   if (status /= 0) call mct_die(subname,"Error on scatter of areadst0")
+   if (mytask == 0) then
+!      if (present(dbug)) then
+!         if (dbug > 2) then
+!            write(nulprt,*) subName,'Size of dst ',mct_aVect_lSize(areadst0)
+!            write(nulprt,*) subName,'min/max dst ',minval(areadst0%rAttr(1,:)),maxval(areadst0%rAttr(1,:))
+!         endif
+!      end if
+      call mct_aVect_clean(areadst0)
+   endif
+   endif
+
+   if (present(ni_i) .and. present(nj_i) .and. present(ni_o) .and. present(nj_o)) then
+      call oasis_mpi_bcast(ni_i,mpicom,subName//" MPI in ni_i bcast")
+      call oasis_mpi_bcast(nj_i,mpicom,subName//" MPI in nj_i bcast")
+      call oasis_mpi_bcast(ni_o,mpicom,subName//" MPI in ni_o bcast")
+      call oasis_mpi_bcast(nj_o,mpicom,subName//" MPI in nj_o bcast")
+   end if
+
+   call oasis_mpi_bcast(ns,mpicom,subName//" MPI in ns bcast")
+   call oasis_mpi_bcast(na,mpicom,subName//" MPI in na bcast")
+   call oasis_mpi_bcast(nb,mpicom,subName//" MPI in nb bcast")
+   call oasis_mpi_bcast(nwgts,mpicom,subName//" MPI in nwgts bcast")
+
+   !--- setup local seg map, sorted
+   if (newdom == 'src') then
+      mygsmap => DgsMap
+   elseif (newdom == 'dst') then
+      mygsmap => SgsMap
+   else
+      write(nulprt,F00) 'ERROR: invalid newdom value = ',newdom
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+   lsize = 0
+   do n = 1,size(mygsmap%start)
+      if (mygsmap%pe_loc(n) == mytask) then
+         lsize=lsize+1
+      endif
+   enddo
+   allocate(lsstart(lsize),lscount(lsize),stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: allocate Lsstart',status)
+
+   lsize = 0
+   do n = 1,size(mygsmap%start)
+      if (mygsmap%pe_loc(n) == mytask) then  ! on my pe
+         lsize=lsize+1
+         found = .false.
+         l1 = 1
+         do while (.not.found .and. l1 < lsize)         ! bubble sort copy
+            if (mygsmap%start(n) < lsstart(l1)) then
+               do l2 = lsize, l1+1, -1
+                  lsstart(l2) = lsstart(l2-1)
+                  lscount(l2) = lscount(l2-1)
+               enddo
+               found = .true.
+            else
+               l1 = l1 + 1
+            endif
+         enddo
+         lsstart(l1) = mygsmap%start(n)
+         lscount(l1) = mygsmap%length(n)
+      endif
+   enddo
+   do n = 1,lsize-1
+      if (lsstart(n) > lsstart(n+1)) then
+         write(nulprt,F00) ' ERROR: lsstart not properly sorted'
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+   enddo
+
+   rsize = min(rbuf_size,ns)                     ! size of i/o chunks
+   bsize = ((ns/commsize) + 1 ) * 1.2   ! local temporary buffer size
+   if (ns == 0) then
+      nread = 0
+   else
+      nread = (ns-1)/rsize + 1                      ! num of reads to do
+   endif
+
+   if (mytask == 0) then
+      allocate(remaps(nwgts,rsize),stat=status)
+      if (status /= 0) call mct_perr_die(subName,':: allocate remaps',status)
+   endif
+   allocate(Smat(nwgts),stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: allocate Smat',status)
+   allocate(Sbuf(nwgts,rsize),Rbuf(rsize),Cbuf(rsize),stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: allocate Sbuf',status)
+   allocate(Snew(nwgts,bsize),Cnew(bsize),Rnew(bsize),stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: allocate Snew1',status)
+
+   cnt = 0
+   do n = 1,nread
+      start(1) = (n-1)*rsize + 1
+      count(1) = min(rsize,ns-start(1)+1)
+      start2(1) = 1
+      count2(1) = nwgts
+      start2(2) = start(1)
+      count2(2) = count(1)
+
+      !--- read data on root pe
+      if (mytask== 0) then
+!        status = nf90_inq_varid      (fid,'S'  ,vid)
+         status = nf90_inq_varid      (fid,'remap_matrix'  ,vid)
+!        status = nf90_get_var(fid,vid,start,count,Sbuf)
+         status = nf90_get_var(fid,vid,remaps,start2,count2)
+         Sbuf(:,:) = remaps(:,:)
+         IF (status /= NF90_NOERR) THEN
+             WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+             WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+         ENDIF
+
+!        status = nf90_inq_varid      (fid,'row',vid)
+         status = nf90_inq_varid      (fid,'dst_address',vid)
+         status = nf90_get_var   (fid,vid,Rbuf,start,count)
+         IF (status /= NF90_NOERR) THEN
+             WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+             WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+         ENDIF
+
+!        status = nf90_inq_varid      (fid,'col',vid)
+         status = nf90_inq_varid      (fid,'src_address',vid)
+         status = nf90_get_var   (fid,vid,Cbuf,start,count)
+         IF (status /= NF90_NOERR) THEN
+             WRITE(nulprt,F00) TRIM(nf90_strerror(status))
+             WRITE(nulprt,*) subname,'model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+         ENDIF
+      endif
+
+      !--- send S, row, col to all pes
+      call oasis_mpi_bcast(Sbuf,mpicom,subName//" MPI in Sbuf bcast")
+      call oasis_mpi_bcast(Rbuf,mpicom,subName//" MPI in Rbuf bcast")
+      call oasis_mpi_bcast(Cbuf,mpicom,subName//" MPI in Cbuf bcast")
+
+      !--- now each pe keeps what it should
+      do m = 1,count(1)
+         !--- should this weight be on my pe
+         if (newdom == 'src') then
+            mywt = check_myindex(Rbuf(m),lsstart,lscount)
+         elseif (newdom == 'dst') then
+            mywt = check_myindex(Cbuf(m),lsstart,lscount)
+         endif
+
+         if (mywt) then
+            cntold = cnt
+            cnt = cnt + 1
+
+            !--- new arrays need to be bigger
+            if (cnt > bsize) then
+               !--- allocate old arrays and copy new into old
+               allocate(Sold(1:nwgts,cntold),Rold(cntold),Cold(cntold),stat=status)
+               if (status /= 0) call mct_perr_die(subName,':: allocate old',status)
+               Sold(1:nwgts,1:cntold) = Snew(1:nwgts,1:cntold)
+               Rold(1:cntold) = Rnew(1:cntold)
+               Cold(1:cntold) = Cnew(1:cntold)
+
+               !--- reallocate new to bigger size, increase buffer by 50% (arbitrary)
+               deallocate(Snew,Rnew,Cnew,stat=status)
+               if (status /= 0) call mct_perr_die(subName,':: allocate new',status)
+               bsize = 1.5 * bsize
+               if (OASIS_debug > 15) write(nulprt,F01) ' reallocate bsize to ',bsize
+               allocate(Snew(nwgts,bsize),Rnew(bsize),Cnew(bsize),stat=status)
+               if (status /= 0) call mct_perr_die(subName,':: allocate old',status)
+
+               !--- copy data back into new
+               Snew(1:nwgts,1:cntold) = Sold(1:nwgts,1:cntold)
+               Rnew(1:cntold) = Rold(1:cntold)
+               Cnew(1:cntold) = Cold(1:cntold)
+               deallocate(Sold,Rold,Cold,stat=status)
+               if (status /= 0) call mct_perr_die(subName,':: deallocate old',status)
+            endif
+
+            Snew(1:nwgts,cnt) = Sbuf(1:nwgts,m)
+            Rnew(cnt) = Rbuf(m)
+            Cnew(cnt) = Cbuf(m)
+         endif
+      enddo  ! count
+   enddo   ! nread
+
+   if (mytask == 0) then
+      deallocate(remaps, stat=status)
+      if (status /= 0) call mct_perr_die(subName,':: deallocate remaps',status)
+   endif
+   deallocate(Sbuf,Rbuf,Cbuf, stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: deallocate Sbuf',status)
+
+   !----------------------------------------------------------------------------
+   ! init the mct sMat data type
+   !----------------------------------------------------------------------------
+   ! mct_sMat_init must be given the number of rows and columns that
+   ! would be in the full matrix.  Nrows= size of output vector=nb.
+   ! Ncols = size of input vector = na.
+   do n = 1,nwgts
+      call mct_sMat_init(sMat(n), nb, na, cnt)
+   enddo
+
+   igrow = mct_sMat_indexIA(sMat(1),'grow')
+   igcol = mct_sMat_indexIA(sMat(1),'gcol')
+   iwgt  = mct_sMat_indexRA(sMat(1),'weight')
+
+   if (cnt /= 0) then
+   do n = 1,nwgts
+      sMat(n)%data%rAttr(iwgt ,1:cnt) = Snew(n,1:cnt)
+      sMat(n)%data%iAttr(igrow,1:cnt) = Rnew(1:cnt)
+      sMat(n)%data%iAttr(igcol,1:cnt) = Cnew(1:cnt)
+   enddo
+   endif
+   deallocate(Snew,Rnew,Cnew, stat=status)
+   deallocate(lsstart,lscount,stat=status)
+   if (status /= 0) call mct_perr_die(subName,':: deallocate new',status)
+
+   if (mytask == 0) then
+      status = nf90_close(fid)
+      IF (OASIS_debug >= 2) THEN
+          WRITE(nulprt,F00) "... done reading file"
+          CALL oasis_flush(nulprt)
+      ENDIF
+   endif
+
+  call oasis_debug_exit(subname)
+
+end subroutine oasis_coupler_sMatReaddnc
+
+!------------------------------------------------------------
+! !BOP ===========================================================================
+!
+! !IROUTINE:  check_myindex - binary search for index in list
+!
+! !DESCRIPTION: 
+!     Do a binary search to see if a value is contained in a list of
+!     values.  return true or false.  starti must be monotonically
+!     increasing, function does NOT check this.
+!
+! !INTERFACE:  -----------------------------------------------------------------
+
+logical function check_myindex(index,starti,counti)
+
+! !USES:
+
+   !--- local kinds ---
+   integer,parameter :: R8 = ip_double_p
+   integer,parameter :: IN = ip_i4_p
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   integer(IN) :: index       ! is this index in start/count list
+   integer(IN) :: starti(:)   ! start list
+   integer(IN) :: counti(:)   ! count list
+
+! !EOP
+
+   !--- local ---
+   integer(IN)    :: nl,nc,nr,ncprev 
+   integer(IN)    :: lsize
+   logical        :: stopnow
+
+   !--- formats ---
+   character(*),parameter :: subName = '(check_myindex) '
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+!   call oasis_debug_enter(subname)
+   check_myindex = .false.
+
+   lsize = size(starti)
+   if (lsize < 1) then
+!     call oasis_debug_exit(subname)
+      return
+   endif
+
+   nl = 0
+   nr = lsize + 1
+   nc = (nl+nr)/2
+   stopnow = .false.
+   do while (.not.stopnow)
+      if (index < starti(nc)) then
+         nr = nc
+      elseif (index > (starti(nc) + counti(nc) - 1)) then
+         nl = nc
+      else
+         check_myindex = .true.
+!        call oasis_debug_exit(subname)
+         return
+      endif
+      ncprev = nc
+      nc = (nl + nr)/2
+      if (nc == ncprev .or. nc < 1 .or. nc > lsize) stopnow = .true.
+   enddo
+
+   check_myindex = .false.
+
+!   call oasis_debug_exit(subname)
+
+end function check_myindex
+
+!===============================================================================
+END MODULE mod_oasis_coupler
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_data.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_data.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_data.F90	(revision 4775)
@@ -0,0 +1,89 @@
+MODULE mod_oasis_data
+!     - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+!
+  USE mod_oasis_kinds
+
+  IMPLICIT NONE
+
+  public
+
+! public prism_data_zero
+
+#include <mpif.h>
+
+! GENERAL
+
+  integer(kind=ip_i4_p) :: compid
+  character(len=ic_lvar):: compnm
+  !
+  ! Variables 
+
+  integer(ip_intwp_p)   :: mvar
+  integer(kind=ip_i4_p),parameter :: mvarcpl = 10
+  !
+  CHARACTER(len=ic_field), POINTER :: total_namsrcfld(:), total_namdstfld(:)
+  !
+  type prism_var_type
+     character(len=ic_lvar):: name
+     integer(kind=ip_i4_p) :: part
+     integer(kind=ip_i4_p) :: ndim
+     integer(kind=ip_i4_p) :: num
+     integer(kind=ip_i4_p) :: ops
+     integer(kind=ip_i4_p) :: type
+     integer(kind=ip_i4_p) :: size
+     integer(kind=ip_i4_p) :: ncpl
+     integer(kind=ip_i4_p) :: cpl(mvarcpl)
+  end type prism_var_type
+
+  TYPE(prism_var_type),POINTER :: prism_var(:)
+
+! MPI
+
+  INTEGER(kind=ip_i4_p) :: mpi_comm_global
+  INTEGER(kind=ip_i4_p) :: mpi_rank_global
+  INTEGER(kind=ip_i4_p) :: mpi_size_global
+  INTEGER(kind=ip_i4_p) :: mpi_comm_local
+  INTEGER(kind=ip_i4_p) :: mpi_rank_local
+  INTEGER(kind=ip_i4_p) :: mpi_size_local
+  INTEGER(kind=ip_i4_p) :: mpi_root_local
+  INTEGER(kind=ip_i4_p) :: mpi_err
+  INTEGER(kind=ip_i4_p),allocatable :: mpi_root_global(:)  ! for each model, the rank in comm_world 
+                                                           ! of the root process
+
+  character(len=*) ,parameter :: cspval = "spval_undef"
+  real(ip_double_p),parameter :: rspval = 1.0e36
+  integer(ip_i4_p) ,parameter :: ispval = -999999
+
+  real(ip_double_p),parameter :: prism_pi = 3.14159265358979323846
+  real(ip_double_p),parameter :: eradius = 6371229.    ! meters
+
+!------------------------------------------------------------
+CONTAINS
+!------------------------------------------------------------
+
+  SUBROUTINE oasis_data_zero()
+
+  IMPLICIT NONE
+
+  character(len=*),parameter :: subname = 'oasis_data_zero'
+
+  nulprt = 6
+  nulprt1 = 6
+  OASIS_debug = 0
+  TIMER_debug = 0
+  compid = -1
+  compnm = trim(cspval)
+  mpi_comm_global = -1
+  mpi_rank_global = -1
+  mpi_size_global = -1
+  mpi_comm_local = -1
+  mpi_rank_local = -1
+  mpi_size_local = -1
+  
+END SUBROUTINE oasis_data_zero
+
+!------------------------------------------------------------
+END MODULE mod_oasis_data
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_getput_interface.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_getput_interface.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_getput_interface.F90	(revision 4775)
@@ -0,0 +1,766 @@
+MODULE mod_oasis_getput_interface
+!---------------------------------------------------------------------
+
+    use mod_oasis_kinds
+    use mod_oasis_data
+    use mod_oasis_parameters
+    use mod_oasis_advance
+    use mod_oasis_var
+    use mod_oasis_sys
+    use mct_mod
+
+    implicit none
+    private
+
+    public oasis_put
+    public oasis_get
+
+#include "oasis_os.h"
+
+    integer(kind=ip_i4_p)     istatus(MPI_STATUS_SIZE)
+
+  interface oasis_put
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_put_r14
+     module procedure oasis_put_r24
+#endif
+     module procedure oasis_put_r18
+     module procedure oasis_put_r28
+  end interface
+
+  interface oasis_get
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_get_r14
+     module procedure oasis_get_r24
+#endif
+     module procedure oasis_get_r18
+     module procedure oasis_get_r28
+  end interface
+
+!---------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_put_r14(id_port_id,kstep,fld1,kinfo, &
+    fld2, fld3, fld4, fld5)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_single_p) :: fld1(:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    real(kind=ip_single_p), optional :: fld2(:)
+    real(kind=ip_single_p), optional :: fld3(:)
+    real(kind=ip_single_p), optional :: fld4(:)
+    real(kind=ip_single_p), optional :: fld5(:)
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nsx
+    integer(kind=ip_i4_p) :: n
+    logical :: a2on, a3on, a4on, a5on
+    character(len=*),parameter :: subname = 'oasis_put_r14'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_put is called for a variable not in namcouple: it will not be sent'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    ns = size(fld1,dim=1)
+
+    a2on = .false.
+    a3on = .false.
+    a4on = .false.
+    a5on = .false.
+
+    if (present(fld2)) then
+       a2on = .true.
+       nsx = size(fld2,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld2 size does not match fld1 ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld3)) then
+       a3on = .true.
+       nsx = size(fld3,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld3 size does not match fld1 ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld4)) then
+       a4on = .true.
+       nsx = size(fld4,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR array4 size does not match fld1 ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld5)) then
+       a5on = .true.
+       nsx = size(fld5,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld5 size does not match fld1 ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+
+    IF ((.NOT. a2on) .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(fld1),readrest=.FALSE.)
+    ELSE IF (a2on .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(fld1),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(fld2))
+    ELSE IF (a2on .AND. a3on .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(fld1),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(fld2),&
+                               a3on=a3on,array3=DBLE(fld3))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(fld1),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(fld2),&
+                               a3on=a3on,array3=DBLE(fld3),&
+                               a4on=a4on,array4=DBLE(fld4))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. a5on) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(fld1),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(fld2),&
+                               a3on=a3on,array3=DBLE(fld3),&
+                               a4on=a4on,array4=DBLE(fld4),&
+                               a5on=a5on,array5=DBLE(fld5))
+    ELSE
+        WRITE(nulprt,*) 'Wrong field array argument list in oasis_put'
+        CALL oasis_flush(nulprt)
+    ENDIF
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_put_r14
+
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_put_r18(id_port_id,kstep,fld1,kinfo, &
+    fld2, fld3, fld4, fld5)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_double_p)             :: fld1(:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    real(kind=ip_double_p), optional :: fld2(:)
+    real(kind=ip_double_p), optional :: fld3(:)
+    real(kind=ip_double_p), optional :: fld4(:)
+    real(kind=ip_double_p), optional :: fld5(:)
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nsx
+    integer(kind=ip_i4_p) :: n
+    logical :: a2on, a3on, a4on, a5on
+    character(len=*),parameter :: subname = 'oasis_put_r18'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_put is called for a variable not in namcouple: it will not be sent'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    ns = size(fld1,dim=1)
+
+    a2on = .false.
+    a3on = .false.
+    a4on = .false.
+    a5on = .false.
+
+    if (present(fld2)) then
+       a2on = .true.
+       nsx = size(fld2,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld2 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld3)) then
+       a3on = .true.
+       nsx = size(fld3,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld3 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld4)) then
+       a4on = .true.
+       nsx = size(fld4,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld4 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld5)) then
+       a5on = .true.
+       nsx = size(fld5,dim=1)
+       if (nsx /= ns) then
+          write(nulprt,*) subname,' ERROR fld5 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    IF ((.NOT. a2on) .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din=fld1,readrest=.FALSE.)
+    ELSE IF (a2on .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din=fld1,readrest=.FALSE.,&
+                               a2on=a2on,array2=fld2)
+    ELSE IF (a2on .AND. a3on .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= fld1,readrest=.FALSE.,&
+                               a2on=a2on,array2=fld2,&
+                               a3on=a3on,array3=fld3)
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din=fld1,readrest=.FALSE.,&
+                               a2on=a2on,array2=fld2,&
+                               a3on=a3on,array3=fld3,&
+                               a4on=a4on,array4=fld4)
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. a5on) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din=fld1,readrest=.FALSE.,&
+                               a2on=a2on,array2=fld2,&
+                               a3on=a3on,array3=fld3,&
+                               a4on=a4on,array4=fld4,&
+                               a5on=a5on,array5=fld5)
+    ELSE
+        WRITE(nulprt,*) 'Wrong field array argument list in oasis_put'
+        CALL oasis_flush(nulprt)
+    ENDIF
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_put_r18
+
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_put_r24(id_port_id,kstep,fld1,kinfo, &
+    fld2, fld3, fld4, fld5)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_single_p) :: fld1(:,:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    real(kind=ip_single_p), optional :: fld2(:,:)
+    real(kind=ip_single_p), optional :: fld3(:,:)
+    real(kind=ip_single_p), optional :: fld4(:,:)
+    real(kind=ip_single_p), optional :: fld5(:,:)
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs,nisx,njsx
+    integer(kind=ip_i4_p) :: n,ni,nj
+    logical :: a2on, a3on, a4on, a5on
+    character(len=*),parameter :: subname = 'oasis_put_r24'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_put is called for a variable not in namcouple: it will not be sent'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    nis = size(fld1,dim=1)
+    njs = size(fld1,dim=2)
+    ns = nis*njs
+
+    a2on = .false.
+    a3on = .false.
+    a4on = .false.
+    a5on = .false.
+
+    if (present(fld2)) then
+       a2on = .true.
+       nisx = size(fld2,dim=1)
+       njsx = size(fld2,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld2 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld3)) then
+       a3on = .true.
+       nisx = size(fld3,dim=1)
+       njsx = size(fld3,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld3 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld4)) then
+       a4on = .true.
+       nisx = size(fld4,dim=1)
+       njsx = size(fld4,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld4 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld5)) then
+       a5on = .true.
+       nisx = size(fld5,dim=1)
+       njsx = size(fld5,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld5 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+
+    IF ((.NOT. a2on) .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(PACK(fld1, mask= .true.)),readrest=.FALSE.)
+    ELSE IF (a2on .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(PACK(fld2, mask= .true.)))
+    ELSE IF (a2on .AND. a3on .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=DBLE(PACK(fld3, mask= .TRUE.)))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=DBLE(PACK(fld3, mask= .TRUE.)),&
+                               a4on=a4on,array4=DBLE(PACK(fld4, mask= .TRUE.)))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. a5on) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= DBLE(PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=DBLE(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=DBLE(PACK(fld3, mask= .TRUE.)),&
+                               a4on=a4on,array4=DBLE(PACK(fld4, mask= .TRUE.)),&
+                               a5on=a5on,array5=DBLE(PACK(fld5, mask= .TRUE.)))
+    ELSE
+        WRITE(nulprt,*) 'Wrong field array argument list in oasis_put'
+        CALL oasis_flush(nulprt)
+    ENDIF
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_put_r24
+
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_put_r28(id_port_id,kstep,fld1,kinfo, &
+    fld2, fld3, fld4, fld5)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_double_p) :: fld1(:,:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    real(kind=ip_double_p), optional :: fld2(:,:)
+    real(kind=ip_double_p), optional :: fld3(:,:)
+    real(kind=ip_double_p), optional :: fld4(:,:)
+    real(kind=ip_double_p), optional :: fld5(:,:)
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs,nisx,njsx
+    integer(kind=ip_i4_p) :: n,ni,nj
+    logical :: a2on, a3on, a4on, a5on
+    character(len=*),parameter :: subname = 'oasis_put_r28'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_put is called for a variable not in namcouple: it will not be sent'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    nis = size(fld1,dim=1)
+    njs = size(fld1,dim=2)
+    ns = nis*njs
+
+    a2on = .false.
+    a3on = .false.
+    a4on = .false.
+    a5on = .false.
+
+    if (present(fld2)) then
+       a2on = .true.
+       nisx = size(fld2,dim=1)
+       njsx = size(fld2,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld2 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld3)) then
+       a3on = .true.
+       nisx = size(fld3,dim=1)
+       njsx = size(fld3,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld3 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld4)) then
+       a4on = .true.
+       nisx = size(fld4,dim=1)
+       njsx = size(fld4,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld4 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+    if (present(fld5)) then
+       a5on = .true.
+       nisx = size(fld5,dim=1)
+       njsx = size(fld5,dim=2)
+       if (nisx /= nis .or. njsx /= njs) then
+          write(nulprt,*) subname,' ERROR fld5 size does not match fld ', &
+                          trim(prism_var(nfld)%name)
+          CALL oasis_flush(nulprt)
+          CALL oasis_abort_noarg()
+       endif
+    endif
+
+
+    IF ((.NOT. a2on) .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo, &
+                               array1din= (PACK(fld1, mask= .true.)),readrest=.FALSE.)
+    ELSE IF (a2on .AND. (.NOT. a3on) .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= (PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=(PACK(fld2, mask= .true.)))
+    ELSE IF (a2on .AND. a3on .AND. (.NOT. a4on) .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= (PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=(PACK(fld3, mask= .TRUE.)))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. (.NOT. a5on)) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= (PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=(PACK(fld3, mask= .TRUE.)),&
+                               a4on=a4on,array4=(PACK(fld4, mask= .TRUE.)))
+    ELSE IF (a2on .AND. a3on .AND. a4on .AND. a5on) THEN
+        CALL oasis_advance_run(OASIS_Out,nfld,kstep,kinfo,&
+                               array1din= (PACK(fld1, mask= .TRUE.)),readrest=.FALSE.,&
+                               a2on=a2on,array2=(PACK(fld2, mask= .TRUE.)),&
+                               a3on=a3on,array3=(PACK(fld3, mask= .TRUE.)),&
+                               a4on=a4on,array4=(PACK(fld4, mask= .TRUE.)),&
+                               a5on=a5on,array5=(PACK(fld5, mask= .TRUE.)))
+    ELSE
+        WRITE(nulprt,*) 'Wrong field array argument list in oasis_put'
+        CALL oasis_flush(nulprt)
+    ENDIF
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_put_r28
+
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_get_r14(id_port_id,kstep,rd_field,kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_single_p), intent(inout) :: rd_field(:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs
+    integer(kind=ip_i4_p) :: n,ni,nj
+    real(kind=ip_r8_p), allocatable :: array(:)
+    character(len=*),parameter :: subname = 'oasis_get_r14'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_get is called for variable not in namcouple; it will not be received'
+       if (OASIS_debug >= 1) write(nulprt,*) subname,' BE CAREFUL NOT TO USE IT !!!!!'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    ns = size(rd_field,dim=1)
+
+    allocate(array(ns))
+
+    CALL oasis_advance_run(OASIS_In,nfld,kstep,kinfo,array1dout=array,readrest=.FALSE.)
+
+    IF (kinfo /= OASIS_Ok) THEN
+        rd_field(:) = REAL(array(:))
+    ENDIF
+
+    deallocate(array)
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_get_r14
+
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_get_r18(id_port_id,kstep,rd_field,kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_double_p), intent(inout) :: rd_field(:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs
+    integer(kind=ip_i4_p) :: n,ni,nj
+    character(len=*),parameter :: subname = 'oasis_get_r18'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_get is called for variable not in namcouple; it will not be received'
+       if (OASIS_debug >= 1) write(nulprt,*) subname,' BE CAREFUL NOT TO USE IT !!!!!'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    CALL oasis_advance_run(OASIS_In,nfld,kstep,kinfo,array1dout=rd_field,readrest=.FALSE.)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_get_r18
+
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_get_r24(id_port_id,kstep,rd_field,kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_single_p), intent(inout) :: rd_field(:,:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs
+    integer(kind=ip_i4_p) :: n,ni,nj
+    REAL(kind=ip_r8_p), ALLOCATABLE :: array(:,:)
+    character(len=*),parameter :: subname = 'oasis_get_r24'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_get is called for variable not in namcouple; it will not be received'
+       if (OASIS_debug >= 1) write(nulprt,*) subname,' BE CAREFUL NOT TO USE IT !!!!!'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    nis = size(rd_field,dim=1)
+    njs = size(rd_field,dim=2)
+    ns = nis*njs
+
+    ALLOCATE(array(nis,njs))
+
+    CALL oasis_advance_run(OASIS_In,nfld,kstep,kinfo,array2dout=array,readrest=.FALSE.)
+
+    IF (kinfo /= OASIS_Ok) THEN
+        rd_field(:,:) = REAL(array(:,:))
+    ENDIF
+
+    deallocate(array)
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_get_r24
+
+!---------------------------------------------------------------------
+  SUBROUTINE oasis_get_r28(id_port_id,kstep,rd_field,kinfo)
+
+    IMPLICIT none
+    !-------------------------------------
+    integer(kind=ip_i4_p) , intent(in) :: id_port_id,kstep
+    real(kind=ip_double_p), intent(inout) :: rd_field(:,:)
+    integer(kind=ip_i4_p) , intent(out), optional :: kinfo
+    !-------------------------------------
+    integer(kind=ip_i4_p) :: nfld,ncpl
+    integer(kind=ip_i4_p) :: ns,nis,njs
+    integer(kind=ip_i4_p) :: n,ni,nj
+    character(len=*),parameter :: subname = 'oasis_get_r28'
+    !-------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    kinfo = OASIS_OK
+
+    if (id_port_id == OASIS_Var_Uncpl) then
+       if (OASIS_debug >= 1) write(nulprt,*) subname, &
+          ' Routine oasis_get is called for variable not in namcouple; it will not be received'
+       if (OASIS_debug >= 1) write(nulprt,*) subname,' BE CAREFUL NOT TO USE IT !!!!!'
+       call oasis_abort_noarg()
+       return
+    endif
+
+    nfld = id_port_id
+    ncpl  = prism_var(nfld)%ncpl
+
+    if (ncpl <= 0) then
+       if (OASIS_debug >= 15) write(nulprt,*) subname,' variable not coupled ',&
+                                              trim(prism_var(nfld)%name)
+       call oasis_debug_exit(subname)
+       return
+    endif
+
+    CALL oasis_advance_run(OASIS_In,nfld,kstep,kinfo,array2dout=rd_field,readrest=.FALSE.)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_get_r28
+
+!-------------------------------------------------------------------
+
+END MODULE mod_oasis_getput_interface
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_grid.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_grid.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_grid.F90	(revision 4775)
@@ -0,0 +1,688 @@
+MODULE mod_oasis_grid
+!-----------------------------------------------------------------------
+! BOP
+!
+! !MODULE:  mod_prism_grid
+! !REMARKS: 
+!
+! **********************
+! THIS SHOULD BE CALLED BY A SINGLE PE ACCORDING TO THE OASIS3 
+! STANDARD.  THE DATA IS GLOBAL.
+! **********************
+!
+! !REVISION HISTORY:
+! 
+!
+! !PUBLIC MEMBER FUNCTIONS:
+! 
+!      subroutine oasis_start_grids_writing(iwrite)
+!             This subroutine initializes grid writing by receiving a 
+!             starting command from OASIS.
+!
+!      subroutine oasis_write_grid(cgrid, nx, ny, lon, lat)
+!	      This subroutine writes longitudes and latitudes for a model
+!             grid.
+!
+!      subroutine oasis_write_corner(cgrid, nx, ny, nc, clon, clat)
+!	      This subroutine writes the longitudes and latitudes of the
+!             grid cell corners.
+!
+!      subroutine oasis_write_mask(cgrid, nx, ny, mask)
+!	      This subroutine writes the mask for a model grid
+!
+!      subroutine oasis_write_area(cgrid, nx, ny, area)
+!	      This subroutine writes the grid cell areas for a model grid.
+!
+!      subroutine oasis_terminate_grids_writing()
+!             This subroutine terminates grid writing by sending a flag
+!             to OASIS, stating the all needed grid information was written.
+!       
+
+! !USES:
+  use mod_oasis_data
+  use mod_oasis_io
+  use mod_oasis_sys
+  
+  implicit none
+
+  private
+
+  public oasis_start_grids_writing
+  public oasis_write_grid
+  public oasis_write_angle
+  public oasis_write_corner
+  public oasis_write_mask
+  public oasis_write_area   
+  public oasis_terminate_grids_writing 
+  public oasis_write2files
+
+  interface oasis_write_grid
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_write_grid_r4
+#endif
+     module procedure oasis_write_grid_r8
+  end interface
+
+  interface oasis_write_angle
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_write_angle_r4
+#endif
+     module procedure oasis_write_angle_r8
+  end interface
+
+  interface oasis_write_corner
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_write_corner_r4
+#endif
+     module procedure oasis_write_corner_r8
+  end interface
+
+  interface oasis_write_area
+#ifndef __NO_4BYTE_REALS
+     module procedure oasis_write_area_r4
+#endif
+     module procedure oasis_write_area_r8
+  end interface
+
+  !--- datatypes ---
+  public :: prism_grid_type
+
+  integer(kind=ip_intwp_p),parameter :: mgrid = 100
+
+  type prism_grid_type
+     character(len=ic_med)  :: gridname
+     integer(kind=ip_i4_p)  :: nx
+     integer(kind=ip_i4_p)  :: ny
+     integer(kind=ip_i4_p)  :: nc
+     logical                :: grid_set
+     logical                :: corner_set
+     logical                :: angle_set
+     logical                :: area_set
+     logical                :: mask_set
+     logical                :: written
+     logical                :: terminated
+     real(kind=ip_realwp_p),allocatable :: lon(:,:)     ! longitudes
+     real(kind=ip_realwp_p),allocatable :: lat(:,:)     ! latitudes
+     real(kind=ip_realwp_p),allocatable :: clon(:,:,:)  ! corner longitudes
+     real(kind=ip_realwp_p),allocatable :: clat(:,:,:)  ! corner latitudes
+     real(kind=ip_realwp_p),allocatable :: angle(:,:)   ! angle
+     real(kind=ip_realwp_p),allocatable :: area(:,:)    ! area
+     integer(kind=ip_i4_p) ,allocatable :: mask(:,:)    ! mask
+  end type prism_grid_type
+
+  integer(kind=ip_intwp_p),public,save :: prism_ngrid = 0
+  type(prism_grid_type),public,save :: prism_grid(mgrid)
+
+
+#ifdef use_netCDF
+#include <netcdf.inc>
+#endif
+
+!---------------------------------------------------------------------------
+
+CONTAINS
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_start_grids_writing(iwrite)
+
+    !-------------------------------------------------
+    ! Routine to start the grids writing. To syncronize access to the
+    ! grids file all component models have to wait for the starting 
+    ! message from OASIS (via MPI; see prism_init_comp_proto)
+    !-------------------------------------------------
+
+    implicit none
+  
+    integer(kind=ip_intwp_p), intent (OUT) :: iwrite ! flag to state whether
+                                            ! grids file needs to be written
+    !-------------------------------------------------
+    character(len=*),parameter :: subname = 'oasis_start_grids_writing'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    if (prism_ngrid == 0) then  ! first call
+       prism_grid(:)%grid_set   = .false.
+       prism_grid(:)%corner_set = .false.
+       prism_grid(:)%angle_set  = .false.
+       prism_grid(:)%area_set   = .false.
+       prism_grid(:)%mask_set   = .false.
+       prism_grid(:)%written    = .false.
+    endif
+    iwrite = 1   ! just set grids are needed always
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_start_grids_writing
+
+!--------------------------------------------------------------------------
+
+    SUBROUTINE oasis_write_grid_r8(cgrid, nx, ny, lon, lat)
+
+    !-------------------------------------------------
+    ! Routine to create a new grids file or to add a grid description to an
+    ! existing grids file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid      ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx         ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny         ! number of latitudes
+    real(kind=ip_double_p),   intent (in) :: lon(nx,ny) ! longitudes
+    real(kind=ip_double_p),   intent (in) :: lat(nx,ny) ! latitudes
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: GRIDID
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_grid_r8'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    call oasis_findgrid(cgrid,nx,ny,gridID)
+
+    allocate(prism_grid(gridID)%lon(nx,ny),stat=ierror)
+    IF (ierror /= 0) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING lon alloc'
+    allocate(prism_grid(gridID)%lat(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING lat alloc'
+    prism_grid(gridID)%lon = lon
+    prism_grid(gridID)%lat = lat
+    prism_grid(gridID)%grid_set = .true.
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_grid_r8
+
+!--------------------------------------------------------------------------
+
+    SUBROUTINE oasis_write_grid_r4(cgrid, nx, ny, lon, lat)
+
+    !-------------------------------------------------
+    ! Routine to create a new grids file or to add a grid description to an
+    ! existing grids file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid      ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx         ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny         ! number of latitudes
+    real(kind=ip_single_p),   intent (in) :: lon(nx,ny) ! longitudes
+    real(kind=ip_single_p),   intent (in) :: lat(nx,ny) ! latitudes
+    !-------------------------------------------------
+    real(kind=ip_double_p), allocatable :: lon8(:,:)
+    real(kind=ip_double_p), allocatable :: lat8(:,:)
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_grid_r4'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    allocate(lon8(nx,ny),stat=ierror)
+    IF (ierror /= 0) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING lon alloc'
+    allocate(lat8(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING lat alloc'
+
+    lon8 = lon
+    lat8 = lat
+    call oasis_write_grid_r8(cgrid,nx,ny,lon8,lat8)
+    deallocate(lon8)
+    deallocate(lat8)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_grid_r4
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_angle_r8(cgrid, nx, ny, angle)
+
+    !-------------------------------------------------
+    ! Routine to add angles to an existing grid file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    real(kind=ip_double_p),   intent (in) :: angle(nx,ny) ! angles
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: GRIDID
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_angle_r8'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    call oasis_findgrid(cgrid,nx,ny,gridID)
+
+    allocate(prism_grid(gridID)%angle(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING angle alloc'
+    prism_grid(gridID)%angle = angle
+    prism_grid(gridID)%angle_set = .true.
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_angle_r8
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_angle_r4(cgrid, nx, ny, angle)
+
+    !-------------------------------------------------
+    ! Routine to add angles to an existing grid file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    real(kind=ip_single_p),   intent (in) :: angle(nx,ny) ! angles
+    !-------------------------------------------------
+    real(kind=ip_double_p),allocatable :: angle8(:,:)
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_angle_r4'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    allocate(angle8(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING angle8 alloc'
+
+    angle8 = angle
+    call oasis_write_angle_r8(cgrid,nx,ny,angle8)
+
+    deallocate(angle8)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_angle_r4
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_corner_r8(cgrid, nx, ny, nc, clon, clat)
+
+    !-------------------------------------------------
+    ! Routine to add longitudes and latitudes of grid cell corners to an
+    ! existing grids file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid  ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx     ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny     ! number of latitudes
+    integer(kind=ip_intwp_p), intent (in) :: nc     ! number of corners per cell
+    real(kind=ip_double_p),   intent (in) :: clon(nx,ny,nc) ! longitudes
+    real(kind=ip_double_p),   intent (in) :: clat(nx,ny,nc) ! latitudes
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: GRIDID
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_corner_r8'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       call oasis_abort_noarg()
+    endif
+
+    call oasis_findgrid(cgrid,nx,ny,gridID)
+
+    allocate(prism_grid(gridID)%clon(nx,ny,nc),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING clon alloc'
+    allocate(prism_grid(gridID)%clat(nx,ny,nc),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING clat alloc'
+    prism_grid(gridID)%nc = nc
+    prism_grid(gridID)%clon = clon
+    prism_grid(gridID)%clat = clat
+    prism_grid(gridID)%corner_set = .true.
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_corner_r8
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_corner_r4(cgrid, nx, ny, nc, clon, clat)
+
+    !-------------------------------------------------
+    ! Routine to add longitudes and latitudes of grid cell corners to an
+    ! existing grids file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid  ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx     ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny     ! number of latitudes
+    integer(kind=ip_intwp_p), intent (in) :: nc     ! number of corners per cell
+    real(kind=ip_single_p),   intent (in) :: clon(nx,ny,nc) ! longitudes
+    real(kind=ip_single_p),   intent (in) :: clat(nx,ny,nc) ! latitudes
+    !-------------------------------------------------
+    real(kind=ip_double_p), allocatable :: clon8(:,:,:),clat8(:,:,:)
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_corner_r4'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    allocate(clon8(nx,ny,nc),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING clon8 alloc'
+    allocate(clat8(nx,ny,nc),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING clat8 alloc'
+
+    clon8 = clon
+    clat8 = clat
+    call oasis_write_corner_r8(cgrid,nx,ny,nc,clon8,clat8)
+
+    deallocate(clon8)
+    deallocate(clat8)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_corner_r4
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_mask(cgrid, nx, ny, mask)
+
+    !-------------------------------------------------
+    ! Routine to create a new masks file or to add a land see mask to an
+    ! existing masks file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    integer(kind=ip_intwp_p), intent (in) :: mask(nx,ny) ! mask
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: GRIDID
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_mask'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    call oasis_findgrid(cgrid,nx,ny,gridID)
+
+    allocate(prism_grid(gridID)%mask(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING mask alloc'
+    prism_grid(gridID)%mask = mask
+    prism_grid(gridID)%mask_set = .true.
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_mask
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_area_r8(cgrid, nx, ny, area)
+
+    !-------------------------------------------------
+    ! Routine to create a new areas file or to add areas of a grid to an
+    ! existing areas file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    real(kind=ip_double_p),   intent (in) :: area(nx,ny) ! areas
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: GRIDID
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_area_r8'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    call oasis_findgrid(cgrid,nx,ny,gridID)
+
+    allocate(prism_grid(gridID)%area(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING area alloc'
+    prism_grid(gridID)%area = area
+    prism_grid(gridID)%area_set = .true.
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_area_r8
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write_area_r4(cgrid, nx, ny, area)
+
+    !-------------------------------------------------
+    ! Routine to create a new areas file or to add areas of a grid to an
+    ! existing areas file.
+    !-------------------------------------------------
+
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    real(kind=ip_single_p),   intent (in) :: area(nx,ny) ! areas
+    !-------------------------------------------------
+    real(kind=ip_double_p), allocatable :: area8(:,:)
+    integer(kind=ip_intwp_p) :: ierror
+    character(len=*),parameter :: subname = 'oasis_write_area_r4'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    allocate(area8(nx,ny),stat=ierror)
+    if (ierror /= 0) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                     mpi_rank_local,' WARNING area8 alloc'
+
+    area8 = area
+    call oasis_write_area_r8(cgrid,nx,ny,area8)
+
+    deallocate(area8)
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write_area_r4
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_terminate_grids_writing()
+    !-------------------------------------------------
+    ! Routine to terminate the grids writing.
+    !-------------------------------------------------
+
+    implicit none
+    integer(kind=ip_i4_p) :: n
+    character(len=*),parameter :: subname = 'oasis_terminate_grids_writing'
+
+    call oasis_debug_enter(subname)
+
+    if (mpi_rank_local /= mpi_root_local) then
+       write(nulprt,*) subname,' ERROR subroutine call by non root processor'
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+
+    do n = 1,prism_ngrid
+       prism_grid(n)%terminated = .true.
+    enddo
+
+! moved to prism_method_enddef for synchronization
+!    call oasis_write2files()
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_terminate_grids_writing
+
+!--------------------------------------------------------------------------
+    SUBROUTINE oasis_write2files()
+
+    !-------------------------------------------------
+    ! Write fields to grid files.
+    ! Only write fields that have been buffered and
+    ! if prism_grid_terminate_grids_writing has been called
+    !-------------------------------------------------
+
+    implicit none
+
+    !-------------------------------------------------
+    character(len=ic_med) :: filename  ! grid filename
+    character(len=ic_med) :: fldname   ! full field name
+    character(len=ic_med) :: cgrid     ! grid name
+    logical :: exists                  ! check if file exists
+    integer(kind=ip_i4_p) :: n         ! counter
+    integer(kind=ip_i4_p) :: nx,ny,nc  ! grid size
+    character(len=*),parameter :: subname = 'oasis_write2files'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    do n = 1,prism_ngrid
+    if (prism_grid(n)%terminated) then
+       cgrid = trim(prism_grid(n)%gridname)
+       prism_grid(n)%written = .true.
+
+       nx = prism_grid(n)%nx
+       ny = prism_grid(n)%ny
+       nc = prism_grid(n)%nc
+
+       if (prism_grid(n)%grid_set) then
+          filename = 'grids.nc'
+          fldname  = trim(cgrid)//'.lon'
+          call oasis_io_write_2dgridfld_fromroot(filename,fldname,prism_grid(n)%lon,nx,ny)
+          fldname  = trim(cgrid)//'.lat'
+          call oasis_io_write_2dgridfld_fromroot(filename,fldname,prism_grid(n)%lat,nx,ny)
+       endif
+
+       if (prism_grid(n)%corner_set) then
+          filename = 'grids.nc'
+          fldname  = trim(cgrid)//'.clo'
+          call oasis_io_write_3dgridfld_fromroot(filename,fldname,prism_grid(n)%clon,nx,ny,nc)
+          fldname  = trim(cgrid)//'.cla'
+          call oasis_io_write_3dgridfld_fromroot(filename,fldname,prism_grid(n)%clat,nx,ny,nc)
+       endif
+
+       if (prism_grid(n)%area_set) then
+          filename = 'areas.nc'
+          fldname  = trim(cgrid)//'.srf'
+          call oasis_io_write_2dgridfld_fromroot(filename,fldname,prism_grid(n)%area,nx,ny)
+       endif
+
+       if (prism_grid(n)%angle_set) then
+          filename = 'grids.nc'
+          fldname  = trim(cgrid)//'.ang'
+          call oasis_io_write_2dgridfld_fromroot(filename,fldname,prism_grid(n)%angle,nx,ny)
+       endif
+
+       if (prism_grid(n)%mask_set) then
+          filename = 'masks.nc'
+          fldname  = trim(cgrid)//'.msk'
+          call oasis_io_write_2dgridint_fromroot(filename,fldname,prism_grid(n)%mask,nx,ny)
+       endif
+
+    endif  ! terminated
+    enddo
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_write2files
+!--------------------------------------------------------------------------
+
+    SUBROUTINE oasis_findgrid(cgrid,nx,ny,gridID)
+    !-------------------------------------------------
+    ! Routine that sets gridID, identifies existing
+    ! grid with cgrid name or starts a new one
+    !-------------------------------------------------
+    implicit none
+
+    character(len=*),         intent (in) :: cgrid       ! grid acronym
+    integer(kind=ip_intwp_p), intent (in) :: nx          ! number of longitudes
+    integer(kind=ip_intwp_p), intent (in) :: ny          ! number of latitudes
+    integer(kind=ip_intwp_p), intent(out) :: gridID      ! gridID matching cgrid
+    !-------------------------------------------------
+    integer(kind=ip_intwp_p) :: n
+    character(len=*),parameter :: subname = 'oasis_findgrid'
+    !-------------------------------------------------
+
+    call oasis_debug_enter(subname)
+
+    gridID = -1
+    do n = 1,prism_ngrid
+       if (trim(cgrid) == trim(prism_grid(n)%gridname)) then
+          gridID = n
+          ! since grid is defined before, make sure nx,ny match
+          if (nx /= prism_grid(gridID)%nx .or. ny /= prism_grid(gridID)%ny) then
+             write(nulprt,*) subname,' ERROR in predefined grid size',nx,ny, &
+                prism_grid(gridID)%nx,prism_grid(gridID)%ny
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+          endif
+       endif
+    enddo
+
+    if (gridID < 1) then
+       prism_ngrid = prism_ngrid+1
+       gridID = prism_ngrid
+    endif
+
+    prism_grid(gridID)%gridname = trim(cgrid)
+    prism_grid(gridID)%nx = nx
+    prism_grid(gridID)%ny = ny
+
+    call oasis_debug_exit(subname)
+
+  END SUBROUTINE oasis_findgrid
+!--------------------------------------------------------------------------
+END MODULE mod_oasis_grid
+!--------------------------------------------------------------------------
+
+
+     
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_io.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_io.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_io.F90	(revision 4775)
@@ -0,0 +1,1664 @@
+MODULE mod_oasis_io
+
+   USE mod_oasis_kinds
+   USE mod_oasis_data
+   USE mod_oasis_parameters
+   USE mod_oasis_mpi
+   USE mod_oasis_sys
+   USE mod_oasis_ioshr
+   USE mct_mod
+   USE netcdf
+
+   implicit none
+
+   private
+
+   !--- interfaces ---
+   public :: oasis_io_read_avfld
+   public :: oasis_io_read_avfile
+   public :: oasis_io_write_avfile
+   public :: oasis_io_read_array
+   public :: oasis_io_write_array
+   public :: oasis_io_read_avfbf
+   public :: oasis_io_write_avfbf
+   public :: oasis_io_write_2dgridint_fromroot
+   public :: oasis_io_write_2dgridfld_fromroot
+   public :: oasis_io_write_3dgridfld_fromroot
+   public :: oasis_io_read_field_fromroot
+
+!===========================================================================
+CONTAINS
+!===========================================================================
+
+!===============================================================================
+
+subroutine oasis_io_read_avfld(filename,av,gsmap,avfld,filefld,fldtype)
+
+   ! ---------------------------------------
+   ! Reads single field from file to av
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: filename   ! filename
+   type(mct_aVect) , intent(inout) :: av      ! avect
+   type(mct_gsmap) , intent(in) :: gsmap      ! gsmap
+   character(len=*), intent(in) :: avfld      ! av field name
+   character(len=*), intent(in) :: filefld    ! file field name
+   character(len=*), intent(in),optional :: fldtype       ! int or real
+
+   !--- local ---
+   integer(ip_i4_p)    :: n,n1,i,j,fk,fk1    ! index
+   integer(ip_i4_p)    :: nx          ! 2d global size nx
+   integer(ip_i4_p)    :: ny          ! 2d global size ny
+   type(mct_aVect)     :: av_g        ! avect global data
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid2(2),varid ! netcdf info
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   real(ip_double_p),allocatable :: array2(:,:)
+   integer(ip_i4_p) ,allocatable :: array2i(:,:)
+   integer(ip_i4_p)    :: ifldtype     ! field type int (1) or real (2)
+
+   character(len=*),parameter :: subname = 'oasis_io_read_avfld'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   ! empty filename, just return
+
+   call oasis_debug_enter(subname)
+   if (len_trim(filename) < 1) then
+      call oasis_debug_exit(subname)
+      return
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   ifldtype = 2   ! real default
+   if (present(fldtype)) then
+      ifldtype = 0
+      if (trim(fldtype) == 'int')  ifldtype = 1
+      if (trim(fldtype) == 'real') ifldtype = 2
+      if (ifldtype == 0) then
+          WRITE(nulprt,*) subname,' ERROR in fldtype argument'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+          CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+   endif
+
+   call mct_aVect_gather(av,av_g,gsmap,master_task,mpicom)
+
+   if (iam == master_task) then
+
+      inquire(file=trim(filename),exist=exists)
+      if (exists) then
+         status = nf90_open(trim(filename),NF90_NOWRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      else
+         write(nulprt,*) subname,' ERROR: file missing ',trim(filename)
+         WRITE(nulprt,*) subname,' abort by  model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+
+      status = nf90_inq_varid(ncid,trim(filefld),varid)
+      if (status /= nf90_noerr) then
+         write(nulprt,*) subname,':',trim(nf90_strerror(status))
+         WRITE(nulprt,*) subname,' ERROR: filefld variable not found '//trim(filefld)
+         WRITE(nulprt,*) subname,' abort by  model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+      status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+      if (dlen /= 2) then
+         write(nulprt,*) subname,' ERROR: variable ndims ne 2 ',trim(filefld),dlen
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+      status = nf90_inquire_dimension(ncid,dimid2(1),len=nx)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+      status = nf90_inquire_dimension(ncid,dimid2(2),len=ny)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+      if (size(av_g%rAttr,dim=2) /= nx*ny) then
+         write(nulprt,*) subname,' ERROR: av gsize nx ny mismatch ',size(av_g%rAttr,dim=2),nx,ny
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+
+      if (ifldtype == 1) then
+         allocate(array2i(nx,ny))
+         status = nf90_get_var(ncid,varid,array2i)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         n = mct_avect_indexIA(av_g,trim(avfld))
+         n1 = 0
+         do j = 1,ny
+         do i = 1,nx
+            n1 = n1 + 1
+            av_g%iAttr(n,n1) = array2i(i,j)
+         enddo
+         enddo
+         deallocate(array2i)
+      else
+         allocate(array2(nx,ny))
+         status = nf90_get_var(ncid,varid,array2)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         n = mct_avect_indexRA(av_g,trim(avfld))
+         n1 = 0
+         do j = 1,ny
+         do i = 1,nx
+            n1 = n1 + 1
+            av_g%rAttr(n,n1) = array2(i,j)
+         enddo
+         enddo
+         deallocate(array2)
+      endif
+
+      status = nf90_close(ncid)
+      IF (status /= nf90_noerr) THEN
+          WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local,':',&
+                          TRIM(nf90_strerror(status))
+      ENDIF
+
+   endif
+
+   call mct_aVect_scatter(av_g,av,gsmap,master_task,mpicom)
+   if (iam == master_task) then
+      call mct_aVect_clean(av_g)
+   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_read_avfld
+
+!===============================================================================
+
+subroutine oasis_io_write_avfile(rstfile,av,gsmap,nx,ny,nampre)
+
+   ! ---------------------------------------
+   ! Writes all fields from av to file
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: rstfile    ! restart filename
+   type(mct_aVect) , intent(in) :: av         ! avect
+   type(mct_gsmap) , intent(in) :: gsmap      ! gsmap
+   integer(ip_i4_p), intent(in) :: nx         ! 2d global size nx
+   integer(ip_i4_p), intent(in) :: ny         ! 2d global size ny
+   character(len=*), intent(in),optional :: nampre  ! name prepend string
+
+   !--- local ---
+   integer(ip_i4_p)    :: n,n1,i,j,fk,fk1    ! index
+   integer(ip_i4_p)    :: nxf,nyf     ! field size on file
+   type(mct_aVect)     :: av_g        ! avect global data
+   type(mct_string)    :: mstring     ! mct char type
+   character(ic_med)   :: itemc       ! string converted to char
+   character(ic_med)   :: lnampre     ! local nampre
+   character(ic_med)   :: lstring     ! local filename
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid2(2),varid ! netcdf info
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   real(ip_double_p),allocatable :: array2(:,:)
+
+   character(len=*),parameter :: subname = 'oasis_io_write_avfile'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   ! empty filename, just return
+
+   if (len_trim(rstfile) < 1) then
+      call oasis_debug_exit(subname)
+      return
+   endif
+
+   lnampre = ""
+   if (present(nampre)) then
+      lnampre = trim(nampre)
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   call mct_aVect_gather(av,av_g,gsmap,master_task,mpicom)
+
+   if (iam == master_task) then
+      if (size(av_g%rAttr,dim=2) /= nx*ny) then
+         write(nulprt,*) subname,' ERROR: av gsize nx ny mismatch ',&
+                         size(av_g%rAttr,dim=2),nx,ny
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+
+      inquire(file=trim(rstfile),exist=exists)
+      if (exists) then
+         status = nf90_open(trim(rstfile),NF90_WRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_redef(ncid)
+      else
+         status = nf90_create(trim(rstfile),NF90_CLOBBER,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      endif
+
+      do n = 1,mct_aVect_nRAttr(av_g)
+         call mct_aVect_getRList(mstring,n,av_g)
+         itemc = mct_string_toChar(mstring)
+         itemc = trim(lnampre)//trim(itemc)
+         call mct_string_clean(mstring)
+
+         status = nf90_inq_dimid(ncid,trim(itemc)//'_nx',dimid2(1))
+         if (status /= nf90_noerr) then
+            status = nf90_def_dim(ncid,trim(itemc)//'_nx',nx,dimid2(1))
+         endif
+
+         status = nf90_inq_dimid(ncid,trim(itemc)//'_ny',dimid2(2))
+         if (status /= nf90_noerr) then
+            status = nf90_def_dim(ncid,trim(itemc)//'_ny',ny,dimid2(2))
+         endif
+
+         status = nf90_inquire_dimension(ncid,dimid2(1),len=dlen)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         if (dlen /= nx) then
+            write(nulprt,*) subname,' ERROR: dlen ne nx ',dlen,nx
+            CALL oasis_flush(nulprt)
+!            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+!            call oasis_abort_noarg()
+         endif
+
+         status = nf90_inquire_dimension(ncid,dimid2(2),len=dlen)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         if (dlen /= ny) then
+            write(nulprt,*) subname,' ERROR: dlen ne ny ',dlen,ny
+            CALL oasis_flush(nulprt)
+!            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+!            call oasis_abort_noarg()
+         endif
+
+         status = nf90_inq_varid(ncid,trim(itemc),varid)
+         if (status /= nf90_noerr) then
+            status = nf90_def_var(ncid,trim(itemc),NF90_DOUBLE,dimid2,varid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+         endif
+
+      enddo
+
+      status = nf90_enddef(ncid)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+      nxf = 0
+      nyf = 0
+      do n = 1,mct_aVect_nRAttr(av_g)
+         call mct_aVect_getRList(mstring,n,av_g)
+         itemc = mct_string_toChar(mstring)
+         itemc = trim(lnampre)//trim(itemc)
+         call mct_string_clean(mstring)
+         status = nf90_inq_varid(ncid,trim(itemc),varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         if (n == 1) then
+            status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_inquire_dimension(ncid,dimid2(1),len=nxf)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_inquire_dimension(ncid,dimid2(2),len=nyf)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            if (dlen /= 2 .or. nx*ny /= nxf*nyf) then
+               WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+               WRITE(nulprt,*) subname,' abort ERROR: ndims and size does not match on file'
+               CALL oasis_flush(nulprt)
+               call oasis_abort_noarg()
+            endif
+            allocate(array2(nxf,nyf))
+         endif
+
+         n1 = 0
+         do j = 1,nyf
+         do i = 1,nxf
+            n1 = n1 + 1
+            array2(i,j) = av_g%rAttr(n,n1)
+         enddo
+         enddo
+
+         status = nf90_put_var(ncid,varid,array2)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      enddo
+      deallocate(array2)
+      call mct_aVect_clean(av_g)
+
+      status = nf90_close(ncid)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_avfile
+
+!===============================================================================
+
+subroutine oasis_io_read_avfile(rstfile,av,gsmap,abort,nampre,didread)
+
+   ! ---------------------------------------
+   ! Reads all fields for av from file
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: rstfile    ! restart filename
+   type(mct_aVect) , intent(inout) :: av      ! avect
+   type(mct_gsmap) , intent(in) :: gsmap      ! gsmap
+   logical         , intent(in) ,optional :: abort   ! abort on fail flag
+   character(len=*), intent(in) ,optional :: nampre  ! name prepend string
+   logical         , intent(out),optional :: didread ! was something read
+
+   !--- local ---
+   integer(ip_i4_p)    :: n,n1,i,j,fk,fk1    ! index
+   integer(ip_i4_p)    :: nx          ! 2d global size nx
+   integer(ip_i4_p)    :: ny          ! 2d global size ny
+   type(mct_aVect)     :: av_g        ! avect global data
+   type(mct_string)    :: mstring     ! mct char type
+   character(ic_med)   :: itemc       ! string converted to char
+   character(ic_med)   :: lnampre     ! local nampre
+   character(ic_med)   :: lstring     ! local filename
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid2(2),varid ! netcdf info
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   logical             :: labort      ! local abort flag
+   real(ip_double_p),allocatable :: array2(:,:)
+
+   character(len=*),parameter :: subname = 'oasis_io_read_avfile'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   IF (mpi_comm_local /= MPI_COMM_NULL) THEN
+   call oasis_debug_enter(subname)
+
+   if (present(didread)) didread = .false.
+
+   ! empty filename, just return
+
+   if (len_trim(rstfile) < 1) then
+      call oasis_debug_exit(subname)
+      return
+   endif
+
+   labort = .true.
+   if (present(abort)) then
+      labort = abort
+   endif
+
+   lnampre = ""
+   if (present(nampre)) then
+      lnampre = trim(nampre)
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   call mct_aVect_gather(av,av_g,gsmap,master_task,mpicom)
+
+   if (iam == master_task) then
+
+      inquire(file=trim(rstfile),exist=exists)
+      if (.not.exists) then
+         write(nulprt,*) subname,' : WARNING: file missing ',trim(rstfile)
+         WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         IF (labort) THEN
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+         ENDIF
+      else
+         status = nf90_open(trim(rstfile),NF90_NOWRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         do n = 1,mct_aVect_nRAttr(av_g)
+            call mct_aVect_getRList(mstring,n,av_g)
+            itemc = mct_string_toChar(mstring)
+            itemc = trim(lnampre)//trim(itemc)
+            call mct_string_clean(mstring)
+
+            status = nf90_inq_varid(ncid,trim(itemc),varid)
+
+            if (status /= nf90_noerr) then
+               write(nulprt,*) subname,' : WARNING: ',trim(itemc),':',trim(nf90_strerror(status))
+               WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               IF (labort) THEN
+                   WRITE(nulprt,*) subname,'ERROR: var missing'
+                   WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                   CALL oasis_flush(nulprt)
+                   CALL oasis_abort_noarg()
+               ENDIF
+
+            else
+               status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+               if (dlen /= 2) then
+                  write(nulprt,*) subname,' ERROR: variable ndims ne 2 ',trim(itemc),dlen
+                  WRITE(nulprt,*) subname,' abort by  model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+               status = nf90_inquire_dimension(ncid,dimid2(1),len=nx)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+               status = nf90_inquire_dimension(ncid,dimid2(2),len=ny)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+               if (size(av_g%rAttr,dim=2) /= nx*ny) then
+                  write(nulprt,*) subname,' ERROR: av gsize nx ny mismatch ',size(av_g%rAttr,dim=2),nx,ny
+                  WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+
+               allocate(array2(nx,ny))
+
+               status = nf90_get_var(ncid,varid,array2)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+               n1 = 0
+               do j = 1,ny
+               do i = 1,nx
+                  n1 = n1 + 1
+                  av_g%rAttr(n,n1) = array2(i,j)
+               enddo
+               enddo
+               if (present(didread)) didread = .true.
+
+               deallocate(array2)
+            endif  ! varid valid
+         enddo
+
+         status = nf90_close(ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+      endif  ! file exists
+   endif
+
+   call mct_aVect_scatter(av_g,av,gsmap,master_task,mpicom)
+   if (iam == master_task) then
+      call mct_aVect_clean(av_g)
+   endif
+
+   call oasis_debug_exit(subname)
+   ENDIF
+
+end subroutine oasis_io_read_avfile
+
+!===============================================================================
+
+subroutine oasis_io_read_array(rstfile,iarray,ivarname,rarray,rvarname,abort)
+
+   ! ---------------------------------------
+   ! Writes all fields from av to file
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: rstfile    ! restart filename
+   integer(ip_i4_p), intent(inout),optional :: iarray(:) ! data on root
+   character(len=*), intent(in),optional :: ivarname     ! variable name on file
+   real(ip_double_p),intent(inout),optional :: rarray(:) ! data on root
+   character(len=*), intent(in),optional :: rvarname     ! variable name on file
+   logical         , intent(in),optional :: abort        ! abort flag
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncnt
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid1(1),varid ! netcdf info
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   logical             :: labort      ! local abort flag
+
+   character(len=*),parameter :: subname = 'oasis_io_read_array'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   IF (mpi_comm_local /= MPI_COMM_NULL) THEN
+   call oasis_debug_enter(subname)
+
+   ! empty filename, just return
+
+   if (len_trim(rstfile) < 1) then
+      call oasis_debug_exit(subname)
+      return
+   endif
+
+   labort = .true.
+   if (present(abort)) then
+      labort = abort
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   if (iam == master_task) then
+
+      inquire(file=trim(rstfile),exist=exists)
+      if (.not.exists) then
+         write(nulprt,*) subname,' WARNING: file missing ',trim(rstfile)
+         WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         IF (labort) THEN
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             CALL oasis_abort_noarg()
+         ENDIF
+      else
+         status = nf90_open(trim(rstfile),NF90_NOWRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         if (present(iarray)) then
+            if (.not. present(ivarname)) then
+               write(nulprt,*) subname,' ERROR: iarray must have ivarname set'
+               WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               call oasis_abort_noarg()
+            endif
+
+            ncnt = size(iarray)
+
+            status = nf90_inq_varid(ncid,trim(ivarname),varid)
+            if (status /= nf90_noerr) then
+               write(nulprt,*) subname,':',trim(ivarname),':',trim(nf90_strerror(status))
+               WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               IF (labort) THEN
+                   WRITE(nulprt,*) subname,'ERROR: var missing'
+                   WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                   CALL oasis_flush(nulprt)
+                   CALL oasis_abort_noarg()
+               ENDIF
+            else
+               status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid1)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+               if (dlen /= 1) then
+                  write(nulprt,*) subname,' ERROR: variable ndims ne 1 ',trim(ivarname),dlen
+                  WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+               status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+               if (ncnt /= dlen) then
+                  write(nulprt,*) subname,' ERROR: iarray ncnt dlen mismatch ',ncnt,dlen
+                  WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+
+               status = nf90_get_var(ncid,varid,iarray)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+            endif
+         endif
+
+         if (present(rarray)) then
+            if (.not. present(rvarname)) then
+               write(nulprt,*) subname,' ERROR: rarray must have rvarname set'
+               WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               call oasis_abort_noarg()
+            endif
+
+            ncnt = size(rarray)
+
+            status = nf90_inq_varid(ncid,trim(rvarname),varid)
+            if (status /= nf90_noerr) then
+               write(nulprt,*) subname,':',trim(rvarname),':',trim(nf90_strerror(status))
+               WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+               CALL oasis_flush(nulprt)
+               IF (labort) THEN
+                   WRITE(nulprt,*) subname,'ERROR: var missing'
+                   WRITE(nulprt,*) subname,' abort by  model :',compid,' proc :',mpi_rank_local
+                   CALL oasis_flush(nulprt)
+                   CALL oasis_abort_noarg()
+               ENDIF
+            else
+               status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid1)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+               if (dlen /= 1) then
+                  write(nulprt,*) subname,' ERROR: variable ndims ne 1 ',trim(rvarname),dlen
+                  WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+               status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+               if (ncnt /= dlen) then
+                  write(nulprt,*) subname,' ERROR: rarray ncnt dlen mismatch ',ncnt,dlen
+                  WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+                  CALL oasis_flush(nulprt)
+                  call oasis_abort_noarg()
+               endif
+
+               status = nf90_get_var(ncid,varid,rarray)
+               IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                         mpi_rank_local,':',TRIM(nf90_strerror(status))
+            endif
+         endif
+
+         status = nf90_close(ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+      endif
+   endif
+
+   if (present(iarray)) then
+      call oasis_mpi_bcast(iarray,mpicom,trim(subname)//':iarray',master_task)
+   endif
+
+   if (present(rarray)) then
+      call oasis_mpi_bcast(rarray,mpicom,trim(subname)//':rarray',master_task)
+   endif
+
+   call oasis_debug_exit(subname)
+   ENDIF
+
+end subroutine oasis_io_read_array
+
+!===============================================================================
+
+subroutine oasis_io_write_array(rstfile,iarray,ivarname,rarray,rvarname)
+
+   ! ---------------------------------------
+   ! Writes all fields from av to file
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: rstfile    ! restart filename
+   integer(ip_i4_p), intent(in),optional :: iarray(:)   ! data on root
+   character(len=*), intent(in),optional :: ivarname    ! variable name on file
+   real(ip_double_p),intent(in),optional :: rarray(:)   ! data on root
+   character(len=*), intent(in),optional :: rvarname    ! variable name on file
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncnt
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid1(1),varid ! netcdf info
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+
+   character(len=*),parameter :: subname = 'oasis_io_write_array'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   ! empty filename, just return
+
+   if (len_trim(rstfile) < 1) then
+      call oasis_debug_exit(subname)
+      return
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   if (iam == master_task) then
+
+      inquire(file=trim(rstfile),exist=exists)
+      if (exists) then
+         status = nf90_open(trim(rstfile),NF90_WRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_redef(ncid)
+      else
+         status = nf90_create(trim(rstfile),NF90_CLOBBER,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      endif
+
+      if (present(iarray)) then
+         if (.not. present(ivarname)) then
+            write(nulprt,*) subname,' ERROR: iarray must have ivarname set'
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         ncnt = size(iarray)
+
+         status = nf90_inq_dimid(ncid,trim(ivarname)//'_ncnt',dimid1(1))
+         if (status /= nf90_noerr) then
+            status = nf90_def_dim(ncid,trim(ivarname)//'_ncnt',ncnt,dimid1(1))
+         endif
+
+         status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         if (dlen /= ncnt) then
+            write(nulprt,*) subname,' ERROR: iarray dlen ne ncnt ',dlen,ncnt
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         status = nf90_inq_varid(ncid,trim(ivarname),varid)
+         if (status /= nf90_noerr) then
+            status = nf90_def_var(ncid,trim(ivarname),NF90_INT,dimid1,varid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+         endif
+      endif
+
+      if (present(rarray)) then
+         if (.not. present(rvarname)) then
+            write(nulprt,*) subname,' ERROR: rarray must have rvarname set'
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         ncnt = size(rarray)
+
+         status = nf90_inq_dimid(ncid,trim(rvarname)//'_ncnt',dimid1(1))
+         if (status /= nf90_noerr) then
+            status = nf90_def_dim(ncid,trim(rvarname)//'_ncnt',ncnt,dimid1(1))
+         endif
+
+         status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         if (dlen /= ncnt) then
+            write(nulprt,*) subname,' ERROR: rarray dlen ne ncnt ',dlen,ncnt
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         status = nf90_inq_varid(ncid,trim(rvarname),varid)
+         if (status /= nf90_noerr) then
+            status = nf90_def_var(ncid,trim(rvarname),NF90_DOUBLE,dimid1,varid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+         endif
+      endif
+
+      status = nf90_enddef(ncid)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+      if (present(iarray)) then
+         status = nf90_inq_varid(ncid,trim(ivarname),varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_put_var(ncid,varid,iarray)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      endif
+
+      if (present(rarray)) then
+         status = nf90_inq_varid(ncid,trim(rvarname),varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_put_var(ncid,varid,rarray)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      endif
+
+      status = nf90_close(ncid)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_array
+
+!===============================================================================
+
+subroutine oasis_io_write_avfbf(av,gsmap,nx,ny,msec,f_string,filename)
+
+   ! ---------------------------------------
+   ! Write all fields from av to individual field files
+   ! This works only for a single av to a file
+   ! Optionally can specify time info, and filename info
+   ! ---------------------------------------
+
+   implicit none
+
+   type(mct_aVect) , intent(in) :: av         ! avect
+   type(mct_gsmap) , intent(in) :: gsmap      ! gsmap
+   integer(ip_i4_p), intent(in) :: nx         ! 2d global size nx
+   integer(ip_i4_p), intent(in) :: ny         ! 2d global size ny
+   integer(ip_i4_p), intent(in),optional :: msec    ! time info
+   character(len=*), intent(in),optional :: f_string  ! optional f_string to append to filename
+   character(len=*), intent(in),optional :: filename   ! optional output filename
+
+   !--- local ---
+   integer(ip_i4_p)    :: n,n1,i,j,fk,fk1    ! index
+   type(mct_aVect)     :: av_g        ! avect global data
+   type(mct_string)    :: mstring     ! mct char type
+   character(ic_med)   :: itemc       ! f_string converted to char
+   character(ic_med)   :: lfn         ! local filename
+   character(ic_med)   :: lstring     ! local filename
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid3(3),varid ! netcdf info
+   integer(ip_i4_p)    :: start3(3),count3(3)        ! netcdf info
+   integer(ip_i4_p)    :: start1(1),count1(1)        ! netcdf info
+   integer(ip_i4_p)    :: lmsec(1)    ! local msec value
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   logical             :: whead,wdata ! for writing restart/history cdf files
+   real(ip_double_p),allocatable :: array3(:,:,:)
+   real(ip_double_p)   :: tbnds(2)
+
+   character(len=*),parameter :: subname = 'oasis_io_write_avfbf'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lmsec = 0
+   if (present(msec)) then
+      lmsec = msec
+   endif
+
+   lstring = " "
+   if (present(f_string)) then
+      lstring = trim(f_string)
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+#if (PIO_DEFINED)
+! tcraig, not working as of Oct 2011
+   call oasis_ioshr_wopen(lfn,clobber=.true.,cdf64=.true.)
+
+   do fk = fk1,2
+      if (fk == 1) then
+         whead = .true.
+         wdata = .false.
+      elseif (fk == 2) then
+         whead = .false.
+         wdata = .true.
+      else
+          WRITE(nulprt,*) subname,'ERROR: fk illegal'
+          WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         call oasis_abort_noarg()
+      end if
+
+      call oasis_ioshr_write(lfn,&
+               time_units='seconds',time_cal='seconds',time_val=real(lmsec,ip_double_p),&
+               nt=1,whead=whead,wdata=wdata)
+
+      call oasis_ioshr_write(lfn, gsmap, av, 'pout', &
+               whead=whead,wdata=wdata,nx=nx,ny=ny,nt=1, &
+               use_float=.false.)
+   
+      if (fk == 1) call oasis_ioshr_enddef(lfn)
+   enddo
+
+   call oasis_ioshr_close(lfn)
+#else
+
+   call mct_aVect_gather(av,av_g,gsmap,master_task,mpicom)
+   if (iam == master_task) then
+      if (size(av_g%rAttr,dim=2) /= nx*ny) then
+         write(nulprt,*) subname,' ERROR: av gsize nx ny mismatch ',size(av_g%rAttr,dim=2),nx,ny
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+
+      allocate(array3(nx,ny,1))
+      do n = 1,mct_aVect_nRAttr(av_g)
+         call mct_aVect_getRList(mstring,n,av_g)
+         itemc = mct_string_toChar(mstring)
+         call mct_string_clean(mstring)
+         if (present(filename)) then
+            lfn = trim(filename)
+         else
+            lfn = trim(itemc)//trim(lstring)//'.nc'
+         endif
+         n1 = 0
+         do j = 1,ny
+         do i = 1,nx
+            n1 = n1 + 1
+            array3(i,j,1) = av_g%rAttr(n,n1)
+         enddo
+         enddo
+
+         start1 = 1
+         count1 = 1
+         start3 = 1
+         count3(1) = nx
+         count3(2) = ny
+         count3(3) = 1
+
+         inquire(file=trim(lfn),exist=exists)
+         if (exists) then
+            status = nf90_open(lfn,NF90_WRITE,ncid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_inq_dimid(ncid,'time',dimid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_inquire_dimension(ncid,dimid,len=dlen)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            start1(1) = dlen + 1
+            start3(3) = start1(1)
+         else
+            status = nf90_create(lfn,NF90_CLOBBER,ncid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_def_dim(ncid,'nx',nx,dimid3(1))
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_def_dim(ncid,'ny',ny,dimid3(2))
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,dimid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            dimid3(3) = dimid
+            status = nf90_def_var(ncid,'time',NF90_INT,dimid,varid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_def_var(ncid,trim(itemc),NF90_DOUBLE,dimid3,varid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+            status = nf90_enddef(ncid)
+            IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                      mpi_rank_local,':',TRIM(nf90_strerror(status))
+         endif
+
+         status = nf90_inq_varid(ncid,'time',varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_put_var(ncid,varid,lmsec,start1,count1)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_inq_varid(ncid,trim(itemc),varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_put_var(ncid,varid,array3,start3,count3)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_close(ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      enddo
+      deallocate(array3)
+      call mct_aVect_clean(av_g)
+   endif
+
+
+#endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_avfbf
+
+!===============================================================================
+
+subroutine oasis_io_read_avfbf(av,gsmap,msec,f_string,filename)
+
+   ! ---------------------------------------
+   ! Read all fields to av from individual field files
+   ! This works only for a single av from a file
+   ! Optionally can specify time info, and filename info
+   ! ---------------------------------------
+
+   implicit none
+
+   type(mct_aVect) , intent(inout) :: av     ! avect
+   type(mct_gsmap) , intent(in) :: gsmap     ! gsmap
+   integer(ip_i4_p), intent(in),optional :: msec    ! time info
+   character(len=*), intent(in),optional :: f_string  ! optional f_string to append to filename
+   character(len=*), intent(in),optional :: filename   ! optional input filename
+
+   !--- local ---
+   integer(ip_i4_p)    :: n,n1,i,j,fk,fk1    ! index
+   integer(ip_i4_p)    :: nx,ny       ! grid size from file
+   type(mct_aVect)     :: av_g        ! avect global data
+   type(mct_string)    :: mstring     ! mct char type
+   character(ic_med)   :: itemc       ! f_string converted to char
+   character(ic_med)   :: lfn         ! local filename
+   character(ic_med)   :: lstring     ! local filename
+   integer(ip_i4_p)    :: mpicom,master_task,iam     ! mpi info
+   integer(ip_i4_p)    :: ncid,dimid,dimid3(3),varid ! netcdf info
+   integer(ip_i4_p)    :: start3(3),count3(3)        ! netcdf info
+   integer(ip_i4_p)    :: lmsec(1)    ! local msec value
+   integer(ip_i4_p)    :: dlen        ! dimension length
+   integer(ip_i4_p)    :: status      ! error code
+   logical             :: exists      ! file existance
+   logical             :: whead,wdata ! for writing restart/history cdf files
+   real(ip_double_p),allocatable :: array3(:,:,:)
+   integer(ip_i4_p) ,allocatable :: time(:)
+   real(ip_double_p)   :: tbnds(2)
+
+   character(len=*),parameter :: subname = 'oasis_io_read_avfbf'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lmsec = 0
+   if (present(msec)) then
+      lmsec = msec
+   endif
+
+   lstring = " "
+   if (present(f_string)) then
+      lstring = trim(f_string)
+   endif
+
+   mpicom = mpi_comm_local
+   master_task = 0
+   iam = mpi_rank_local
+
+   call mct_aVect_gather(av,av_g,gsmap,master_task,mpicom)
+   if (iam == master_task) then
+      do n = 1,mct_aVect_nRAttr(av_g)
+         call mct_aVect_getRList(mstring,n,av_g)
+         itemc = mct_string_toChar(mstring)
+         call mct_string_clean(mstring)
+         if (present(filename)) then
+            lfn = trim(filename)
+         else
+            lfn = trim(itemc)//trim(lstring)//'.nc'
+         endif
+
+         inquire(file=trim(lfn),exist=exists)
+         if (.not.exists) then
+            write(nulprt,*) subname,' ERROR: file not found ',trim(lfn)
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         status = nf90_open(lfn,NF90_NOWRITE,ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         status = nf90_inq_dimid(ncid,'time',dimid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_inquire_dimension(ncid,dimid,len=dlen)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         allocate(time(dlen))
+         status = nf90_inq_varid(ncid,'time',varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_get_var(ncid,varid,time)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         n1 = 0
+         do j = 1,dlen
+            if (time(j) == lmsec(1)) n1 = j
+         enddo
+         deallocate(time)
+         if (n1 < 1) then
+            write(nulprt,*) subname,' ERROR: time not found on file ',trim(lfn),lmsec
+            WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+
+         status = nf90_inq_varid(ncid,trim(itemc),varid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_inquire_variable(ncid,varid,dimids=dimid3)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_inquire_dimension(ncid,dimid3(1),len=nx)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_inquire_dimension(ncid,dimid3(2),len=ny)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         if (size(av_g%rAttr,dim=2) /= nx*ny) then
+             write(nulprt,*) subname,' ERROR: av gsize nx ny mismatch ',size(av_g%rAttr,dim=2),nx,ny
+             WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+             CALL oasis_flush(nulprt)
+             call oasis_abort_noarg()
+         endif
+
+         start3 = 1
+         count3(1) = nx
+         count3(2) = ny
+         count3(3) = 1
+         start3(3) = n1
+         allocate(array3(nx,ny,1))
+
+         status = nf90_get_var(ncid,varid,array3,start3,count3)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+         status = nf90_close(ncid)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+         n1 = 0
+         do j = 1,ny
+         do i = 1,nx
+            n1 = n1 + 1
+            av_g%rAttr(n,n1) = array3(i,j,1)
+         enddo
+         enddo
+
+         deallocate(array3)
+
+      enddo
+   endif
+
+   call mct_aVect_scatter(av_g,av,gsmap,master_task,mpicom)
+   if (iam == master_task) then
+      call mct_aVect_clean(av_g)
+   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_read_avfbf
+
+!===============================================================================
+
+subroutine oasis_io_read_field_fromroot(filename,fldname,ifld2,fld2,fld3,nx,ny,nz)
+
+   ! ---------------------------------------
+   ! Write real fld on rootpe to file
+   ! Designed to work with oasis3 write_grid 
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*) , intent(in) :: filename
+   character(len=*) , intent(in) :: fldname
+   integer(ip_i4_p) , intent(inout),optional :: ifld2(:,:)
+   real(ip_realwp_p), intent(inout),optional :: fld2(:,:)
+   real(ip_realwp_p), intent(inout),optional :: fld3(:,:,:)
+   integer(ip_i4_p) , intent(inout),optional :: nx         ! global size nx
+   integer(ip_i4_p) , intent(inout),optional :: ny         ! global size ny
+   integer(ip_i4_p) , intent(inout),optional :: nz         ! global size nz
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncid,varid  ! cdf info
+   integer(ip_i4_p)    :: n,ndims,xtype
+   integer(ip_i4_p),allocatable :: dimid(:),nd(:)
+   integer(ip_i4_p)    :: status      ! error code
+   integer(ip_i4_p)    :: ind         ! string index
+   logical             :: exists      ! file existance
+   character(len=ic_med) :: gridname  ! grid name derived from fldname
+
+   character(len=*),parameter :: subname = 'oasis_io_read_field_fromroot'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+!   expects to run only on 1 pe.
+!   if (iam == master_task) then
+
+   inquire(file=trim(filename),exist=exists)
+   if (exists) then
+      status = nf90_open(filename,NF90_NOWRITE,ncid)
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+      status = nf90_redef(ncid)
+   else
+      write(nulprt,*) subname,' ERROR: in filename ',trim(filename)
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   status = nf90_inq_varid(ncid,trim(fldname),varid)
+   if (status /= nf90_noerr) then
+      write(nulprt,*) subname,' ERROR: in variable name ',trim(fldname)
+      WRITE(nulprt,*) subname,' abort by  model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   status = nf90_inquire_variable(ncid,varid,ndims=ndims,xtype=xtype)
+   IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                             mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+   allocate(dimid(ndims),nd(ndims))
+
+   status = nf90_inquire_variable(ncid,varid,dimids=dimid)
+   IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                             mpi_rank_local,':',TRIM(nf90_strerror(status))
+   do n = 1,ndims
+      status = nf90_inquire_dimension(ncid,dimid(n),len=nd(n))
+      IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                mpi_rank_local,':',TRIM(nf90_strerror(status))
+   enddo
+
+   if (present(ifld2) .or. present(fld2) .or. present(fld3)) then
+      if (xtype == NF90_INT .and. ndims == 2 .and. present(ifld2)) then
+         status = nf90_get_var(ncid,varid,ifld2)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      elseif (xtype /= NF90_INT .and. ndims == 2 .and. present(fld2)) then
+         status = nf90_get_var(ncid,varid,fld2)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      elseif (xtype /= NF90_INT .and. ndims == 3 .and. present(fld3)) then
+         status = nf90_get_var(ncid,varid,fld3)
+         IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                   mpi_rank_local,':',TRIM(nf90_strerror(status))
+      else
+         write(nulprt,*) subname,' ERROR: mismatch in field and data'
+         WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+         CALL oasis_flush(nulprt)
+         call oasis_abort_noarg()
+      endif
+   endif
+    
+   status = nf90_close(ncid)
+   IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                             mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+   if (present(nx)) then
+      nx = nd(1)
+   endif
+
+   if (present(ny)) then
+      ny = nd(2)
+   endif
+
+   if (present(nz)) then
+      nz = nd(3)
+   endif
+
+   deallocate(dimid,nd)
+
+!   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_read_field_fromroot
+
+!===============================================================================
+
+subroutine oasis_io_write_2dgridfld_fromroot(filename,fldname,fld,nx,ny)
+
+   ! ---------------------------------------
+   ! Write real fld on rootpe to file
+   ! Designed to work with oasis3 write_grid 
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: filename
+   character(len=*), intent(in) :: fldname
+   real(ip_realwp_p), intent(in) :: fld(:,:)
+   integer(ip_i4_p), intent(in) :: nx         ! 2d global size nx
+   integer(ip_i4_p), intent(in) :: ny         ! 2d global size ny
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncid,dimid,dimid2(2),varid  ! cdf info
+   integer(ip_i4_p)    :: status      ! error code
+   integer(ip_i4_p)    :: ind         ! string index
+   logical             :: exists      ! file existance
+   character(len=ic_med) :: gridname  ! grid name derived from fldname
+
+   character(len=*),parameter :: subname = 'oasis_io_write_2dgridfld_fromroot'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+!   expects to run only on 1 pe.
+!   if (iam == master_task) then
+
+    ind = index(trim(fldname),'.')
+    if (ind < 2) then
+       write(nulprt,*) subname,' ERROR: in fldname ',trim(fldname)
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+    gridname = fldname(1:ind-1)
+
+    inquire(file=trim(filename),exist=exists)
+    if (exists) then
+       status = nf90_open(filename,NF90_WRITE,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_redef(ncid)
+    else
+       status = nf90_create(filename,NF90_CLOBBER,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define x dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid2(1))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid2(1))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define y dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid2(2))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid2(2))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define var if it doesn't exist
+    status = nf90_inq_varid(ncid,trim(fldname),varid)
+    if (status /= nf90_noerr) then
+       status = nf90_def_var(ncid,trim(fldname),NF90_DOUBLE,dimid2,varid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_put_var(ncid,varid,fld)
+       if (status /= nf90_noerr) write(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',trim(nf90_strerror(status))
+    else
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    status = nf90_close(ncid)
+    IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                              mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+!   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_2dgridfld_fromroot
+
+!===============================================================================
+
+subroutine oasis_io_write_2dgridint_fromroot(filename,fldname,fld,nx,ny)
+
+   ! ---------------------------------------
+   ! Write int fld on rootpe to file
+   ! Designed to work with oasis3 write_grid 
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: filename
+   character(len=*), intent(in) :: fldname
+   integer(ip_i4_p), intent(in) :: fld(:,:)
+   integer(ip_i4_p), intent(in) :: nx         ! 2d global size nx
+   integer(ip_i4_p), intent(in) :: ny         ! 2d global size ny
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncid,dimid,dimid2(2),varid  ! cdf info
+   integer(ip_i4_p)    :: status      ! error code
+   integer(ip_i4_p)    :: ind         ! string index
+   logical             :: exists      ! file existance
+   character(len=ic_med) :: gridname  ! grid name derived from fldname
+
+   character(len=*),parameter :: subname = 'oasis_io_write_2dgridint_fromroot'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+!   expects to run only on 1 pe.
+!   if (iam == master_task) then
+
+    ind = index(trim(fldname),'.')
+    if (ind < 2) then
+       write(nulprt,*) subname,' ERROR: in fldname ',trim(fldname)
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+    gridname = fldname(1:ind-1)
+
+    inquire(file=trim(filename),exist=exists)
+    if (exists) then
+       status = nf90_open(filename,NF90_WRITE,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_redef(ncid)
+    else
+       status = nf90_create(filename,NF90_CLOBBER,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define x dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid2(1))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid2(1))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define y dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid2(2))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid2(2))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define var if it doesn't exist
+    status = nf90_inq_varid(ncid,trim(fldname),varid)
+    if (status /= nf90_noerr) then
+       status = nf90_def_var(ncid,trim(fldname),NF90_INT,dimid2,varid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_put_var(ncid,varid,fld)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    else
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    status = nf90_close(ncid)
+    IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                              mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+!   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_2dgridint_fromroot
+
+!===============================================================================
+
+subroutine oasis_io_write_3dgridfld_fromroot(filename,fldname,fld,nx,ny,nc)
+ 
+   ! ---------------------------------------
+   ! Write real 3d fld on rootpe to file
+   ! Designed to work with oasis3 write_grid (corners)
+   ! ---------------------------------------
+
+   implicit none
+
+   character(len=*), intent(in) :: filename
+   character(len=*), intent(in) :: fldname
+   real(ip_realwp_p), intent(in) :: fld(:,:,:)
+   integer(ip_i4_p), intent(in) :: nx         ! 3d global size nx
+   integer(ip_i4_p), intent(in) :: ny         ! 3d global size ny
+   integer(ip_i4_p), intent(in) :: nc         ! 3d global size nc ncorners
+
+   !--- local ---
+   integer(ip_i4_p)    :: ncid,dimid,dimid3(3),varid  ! cdf info
+   integer(ip_i4_p)    :: status      ! error code
+   integer(ip_i4_p)    :: ind         ! string index
+   logical             :: exists      ! file existance
+   character(len=ic_med) :: gridname  ! grid name derived from fldname
+
+   character(len=*),parameter :: subname = 'oasis_io_write_3dgridfld_fromroot'
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+!   expects to run only on 1 pe.
+!   if (iam == master_task) then
+
+    ind = index(trim(fldname),'.')
+    if (ind < 2) then
+       write(nulprt,*) subname,' ERROR: in fldname ',trim(fldname)
+       WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+       CALL oasis_flush(nulprt)
+       call oasis_abort_noarg()
+    endif
+    gridname = fldname(1:ind-1)
+
+    inquire(file=trim(filename),exist=exists)
+    if (exists) then
+       status = nf90_open(filename,NF90_WRITE,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_redef(ncid)
+    else
+       status = nf90_create(filename,NF90_CLOBBER,ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define x dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid3(1))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid3(1))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define y dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid3(2))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid3(2))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define crn dimension if it doesn't exist
+    status = nf90_inq_dimid(ncid,'crn_'//trim(gridname),dimid3(3))
+    if (status /= nf90_noerr) then
+       status = nf90_def_dim(ncid,'crn_'//trim(gridname),nc,dimid3(3))
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    ! define var if it doesn't exist
+    status = nf90_inq_varid(ncid,trim(fldname),varid)
+    if (status /= nf90_noerr) then
+       status = nf90_def_var(ncid,trim(fldname),NF90_DOUBLE,dimid3,varid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+       status = nf90_put_var(ncid,varid,fld)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    else
+       status = nf90_enddef(ncid)
+       IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                                 mpi_rank_local,':',TRIM(nf90_strerror(status))
+    endif
+
+    status = nf90_close(ncid)
+    IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+                                              mpi_rank_local,':',TRIM(nf90_strerror(status))
+
+!   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_io_write_3dgridfld_fromroot
+
+!-------------------------------------------------------------------
+
+END MODULE mod_oasis_io
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_ioshr.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_ioshr.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_ioshr.F90	(revision 4775)
@@ -0,0 +1,1525 @@
+!===============================================================================
+!BOP ===========================================================================
+!
+! !MODULE: mod_oasis_ioshr -- reads and writes driver files
+!
+! !DESCRIPTION:
+!    Writes attribute vectors to netcdf
+!
+! !REMARKS:
+!
+! !REVISION HISTORY:
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+module mod_oasis_ioshr
+
+#if (PIO_DEFINED)
+
+  ! !USES:
+
+  use mod_oasis_kinds, only: r8 => ip_r8_p, in => ip_intwp_p
+  use mod_oasis_kinds, only: cl => ic_long
+  use mod_oasis_data
+  use mod_oasis_sys
+  use mod_oasis_string, only: oasis_string_toupper
+  use mod_oasis_mpi
+  use mct_mod           ! mct wrappers
+  use pio
+
+  implicit none
+  private
+
+! !PUBLIC TYPES:
+
+  ! none
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+  public oasis_ioshr_init
+  public oasis_ioshr_finalize
+  public oasis_ioshr_wopen
+  public oasis_ioshr_close
+  public oasis_ioshr_redef
+  public oasis_ioshr_enddef
+  public oasis_ioshr_date2yyyymmdd
+  public oasis_ioshr_sec2hms
+  public oasis_ioshr_read
+  public oasis_ioshr_write
+!  public oasis_ioshr_getiosys
+  public oasis_ioshr_getiotype
+  public oasis_ioshr_getioroot
+
+! !PUBLIC DATA MEMBERS
+
+  ! none
+
+!EOP
+
+  interface oasis_ioshr_read
+     module procedure oasis_ioshr_read_av
+     module procedure oasis_ioshr_read_int
+     module procedure oasis_ioshr_read_int1d
+     module procedure oasis_ioshr_read_r8
+     module procedure oasis_ioshr_read_r81d
+     module procedure oasis_ioshr_read_char
+  end interface
+  interface oasis_ioshr_write
+     module procedure oasis_ioshr_write_av
+     module procedure oasis_ioshr_write_int
+     module procedure oasis_ioshr_write_int1d
+     module procedure oasis_ioshr_write_r8
+     module procedure oasis_ioshr_write_r81d
+     module procedure oasis_ioshr_write_char
+     module procedure oasis_ioshr_write_time
+  end interface
+
+!-------------------------------------------------------------------------------
+! Local data
+!-------------------------------------------------------------------------------
+
+   character(*),parameter :: prefix = "oasis_ioshr_"
+   character(CL)          :: wfilename = ''
+   real(r8)    ,parameter :: fillvalue = rspval
+   character(CL) :: charvar   ! buffer for string read/write
+
+   character(*),parameter :: modName = "(mod_oasis_ioshr) "
+   integer(in) ,parameter :: debug = 1 ! internal debug level
+
+   character(*),parameter :: version ='oasis_ioshr_v00'
+
+   type(file_desc_t), save :: pio_file
+   type(iosystem_desc_t), save :: pio_iosystem
+   integer(IN),save  :: pio_mpicomm
+   integer(IN),save  :: pio_iam
+   integer(IN),save  :: pio_iotype
+   integer(IN),save  :: pio_stride
+   integer(IN),save  :: pio_numtasks
+   integer(IN),save  :: pio_root
+
+   integer(IN),parameter :: pio_root_default = 0
+
+!=================================================================================
+contains
+!=================================================================================
+
+!=================================================================================
+!BOP =============================================================================
+!
+! !IROUTINE: oasis_ioshr_init - initialize io for coupler
+!
+! !DESCRIPTION:
+!    Read the pio_inparm namelist and initialize the pio subsystem
+!
+! !REVISION HISTORY:
+!    2009-Sep-30 - B. Kauffman - consolidation, clean up
+!    2009-Feb-17 - J. Edwards - initial version
+!
+! !INTERFACE: --------------------------------------------------------------------
+
+  subroutine oasis_ioshr_init(mpicomm,typename,stride,root,numtasks)
+    implicit none
+    integer(IN),intent(in) :: mpicomm
+    character(len=*),intent(in) :: typename
+    integer(IN),intent(in) :: stride
+    integer(IN),intent(in) :: numtasks
+    integer(IN),intent(in) :: root
+
+    integer :: npes
+    character(*),parameter :: subName =   '(oasis_ioshr_init) '
+    character(*),parameter :: F00     = "('(oasis_ioshr_init) ',4a)"
+    character(*),parameter :: F01     = "('(oasis_ioshr_init) ',a,i6)"
+
+    !--------------------------------------------------------------------------
+    ! init pio library
+    !--------------------------------------------------------------------------
+
+    pio_mpicomm  = mpicomm
+    pio_stride   = stride
+    pio_numtasks = numtasks
+    pio_root     = root
+    call getiotypefromname(typename, pio_iotype, pio_iotype_netcdf)
+    call oasis_mpi_commsize(pio_mpicomm,npes)
+    call oasis_mpi_commrank(pio_mpicomm,pio_iam)
+
+    call namelist_set(npes, pio_mpicomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
+
+    if(pio_iam==0) then
+       write(nulprt,F00) 'pio init parameters for : '
+       write(nulprt,F01) '   pio_stride   = ',pio_stride
+       write(nulprt,F01) '   pio_root     = ',pio_root
+       select case(pio_iotype)
+          case (pio_iotype_netcdf)
+             write(nulprt,*) '   pio iotype is netcdf'     
+          case (pio_iotype_netcdf4p)
+             write(nulprt,*) '   pio iotype is netcdf4p'     
+          case (pio_iotype_netcdf4c)
+             write(nulprt,*) '   pio iotype is netcdf4c'     
+          case (pio_iotype_pnetcdf)
+             write(nulprt,*) '   pio iotype is pnetcdf'     
+       end select
+       write(nulprt,F01) '   pio_iotype   = ',pio_iotype
+       write(nulprt,F01) '   pio_numtasks = ',pio_numtasks
+    end if
+    call pio_init(pio_iam, pio_mpicomm, pio_numtasks, 0, pio_stride, &
+                  pio_rearr_box, pio_iosystem, base=pio_root)
+
+  end subroutine oasis_ioshr_init
+
+!===============================================================================
+
+  subroutine getiotypefromname(itypename, iotype, defaulttype)
+     implicit none
+     character(len=*), intent(in) :: itypename
+     integer, intent(out) :: iotype
+     integer, intent(in) :: defaulttype
+
+     character(len=len(itypename)) :: typename
+     character(*),parameter :: subName =   '(oasis_ioshr_getiotypefromname) '
+
+     typename = oasis_string_toUpper(itypename)
+     if      ( typename .eq. 'NETCDF' ) then
+        iotype = pio_iotype_netcdf
+     else if ( typename .eq. 'PNETCDF') then
+        iotype = pio_iotype_pnetcdf
+     else if ( typename .eq. 'NETCDF4P') then
+        iotype = pio_iotype_netcdf4p
+     else if ( typename .eq. 'NETCDF4C') then
+        iotype = pio_iotype_netcdf4c
+     else if ( typename .eq. 'NOTHING') then
+        iotype = defaulttype
+     else
+        write(nulprt,*) 'mod_oasis_ioshr: WARNING Bad io_type argument - using iotype_netcdf'
+        iotype=pio_iotype_netcdf
+     end if
+  end subroutine getiotypefromname
+
+!===============================================================================
+
+  subroutine namelist_set(npes,mycomm, pio_stride, pio_root, pio_numtasks, pio_iotype)
+    implicit none
+    integer, intent(in) :: npes, mycomm
+    integer, intent(inout) :: pio_stride, pio_root, pio_numtasks
+    integer, intent(inout) :: pio_iotype
+    character(*),parameter :: subName =   '(oasis_ioshr_namelist_set) '
+
+
+    call oasis_mpi_bcast(pio_iotype  , mycomm)
+    call oasis_mpi_bcast(pio_stride  , mycomm)
+    call oasis_mpi_bcast(pio_root    , mycomm)
+    call oasis_mpi_bcast(pio_numtasks, mycomm)
+
+    !--------------------------------------------------------------------------
+    ! check/set/correct io pio parameters
+    !--------------------------------------------------------------------------
+
+
+    if (pio_stride>0.and.pio_numtasks<0) then
+       pio_numtasks = npes/pio_stride
+    else if(pio_numtasks>0 .and. pio_stride<0) then
+       pio_stride = npes/pio_numtasks
+    else if(pio_numtasks<0 .and. pio_stride<0) then
+       pio_stride = 4
+       pio_numtasks = npes/pio_stride
+       pio_numtasks = max(1, pio_numtasks)
+    end if
+
+    if (pio_root<0) then
+       pio_root = pio_root_default
+    endif
+    pio_root = min(pio_root,npes-1)
+
+    if (pio_root + (pio_stride)*(pio_numtasks-1) >= npes .or. &
+         pio_stride<=0 .or. pio_numtasks<=0 .or. pio_root < 0 .or. &
+         pio_root > npes-1) then
+       if(npes<100) then
+          pio_stride = max(1,npes/4)
+       else if(npes<1000) then
+          pio_stride = max(1,npes/8)
+       else
+          pio_stride = max(1,npes/16)
+       end if
+       if(pio_stride>1) then
+          pio_numtasks = npes/pio_stride
+          pio_root = min(1,npes-1)
+       else
+          pio_numtasks = npes
+          pio_root = 0
+       end if
+       if(debug>0) then
+          write(nulprt,*) subName,'pio_stride, iotasks or root out of bounds - resetting to defaults: ',&
+               pio_stride,pio_numtasks, pio_root
+       end if
+    end if
+
+
+  end subroutine namelist_set
+
+!===============================================================================
+  subroutine oasis_ioshr_finalize
+    implicit none
+    integer :: ierr
+    character(*),parameter :: subName =   '(oasis_ioshr_finalize) '
+
+    call pio_finalize(pio_iosystem, ierr)
+
+  end subroutine oasis_ioshr_finalize
+
+!===============================================================================
+!  function oasis_ioshr_getiosys() result(iosystem)
+!    implicit none
+!    type(iosystem_desc_t), pointer :: iosystem
+!    character(*),parameter :: subName =   '(oasis_ioshr_getiosys) '
+!
+!    iosystem => pio_iosystem
+!
+!  end function oasis_ioshr_getiosys
+!
+!===============================================================================
+  function oasis_ioshr_getiotype() result(io_type)
+    implicit none
+    integer :: io_type
+    character(*),parameter :: subName =   '(oasis_ioshr_getiotype) '
+
+    io_type = pio_iotype
+
+  end function oasis_ioshr_getiotype
+!===============================================================================
+  function oasis_ioshr_getioroot() result(io_root)
+    implicit none
+    integer :: io_root
+    character(*),parameter :: subName =   '(oasis_ioshr_getioroot) '
+
+    io_root = pio_root
+
+  end function oasis_ioshr_getioroot
+
+
+!===============================================================================
+
+subroutine oasis_ioshr_flds_lookup(fldname,longname,stdname,units)
+    implicit none
+    character(len=*),intent(in)  :: fldname
+    character(len=*),intent(out),optional :: longname
+    character(len=*),intent(out),optional :: stdname
+    character(len=*),intent(out),optional :: units
+    character(*),parameter :: subName =   '(oasis_ioshr_flds_lookup) '
+
+    if (present(longname)) then
+       longname = 'unknown'
+    endif
+    if (present(stdname)) then
+       stdname  = 'unknown'
+    endif
+    if (present(units)) then
+       units    = 'unknown'
+    endif
+
+end subroutine oasis_ioshr_flds_lookup
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_ioshr_wopen - open netcdf file
+!
+! !DESCRIPTION:
+!    open netcdf file
+!
+! !REVISION HISTORY:
+!    2007-Oct-26 - T. Craig - initial version
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_ioshr_wopen(filename,clobber,cdf64)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(*),intent(in) :: filename
+    logical,optional,intent(in):: clobber
+    logical,optional,intent(in):: cdf64
+
+    !EOP
+
+    logical :: exists
+    logical :: lclobber
+    logical :: lcdf64
+    integer :: rcode
+    integer :: nmode
+    character(CL)  :: lversion
+    character(*),parameter :: subName = '(oasis_ioshr_wopen) '
+    
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+    lclobber = .false.
+    if (present(clobber)) lclobber=clobber
+
+    lcdf64 = .false.
+    if (present(cdf64)) lcdf64=cdf64
+
+    if (.not. pio_file_is_open(pio_file)) then
+       ! filename not open
+       if (pio_iam==0) inquire(file=trim(filename),exist=exists)
+       call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_wopen exists')
+       if (exists) then
+          if (lclobber) then
+             nmode = pio_clobber
+             if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
+             rcode = pio_createfile(pio_iosystem, pio_file, pio_iotype, trim(filename), nmode)
+             if(pio_iam==0) write(nulprt,*) subname,' create file ',trim(filename)
+             rcode = pio_put_att(pio_file,pio_global,"file_version",version)
+          else
+
+             rcode = pio_openfile(pio_iosystem, pio_file, pio_iotype, trim(filename), pio_write)
+             if(pio_iam==0) write(nulprt,*) subname,' open file ',trim(filename)
+             call pio_seterrorhandling(pio_file,PIO_BCAST_ERROR)
+             rcode = pio_get_att(pio_file,pio_global,"file_version",lversion)
+             call pio_seterrorhandling(pio_file,PIO_INTERNAL_ERROR)
+             if (trim(lversion) /= trim(version)) then
+                rcode = pio_redef(pio_file)
+                rcode = pio_put_att(pio_file,pio_global,"file_version",version)
+                rcode = pio_enddef(pio_file)
+             endif
+          endif
+       else
+          nmode = pio_noclobber
+          if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
+          rcode = pio_createfile(pio_iosystem, pio_file, pio_iotype, trim(filename), nmode)
+          if(pio_iam==0) write(nulprt,*) subname,' create file ',trim(filename)
+          rcode = pio_put_att(pio_file,pio_global,"file_version",version)
+       endif
+    elseif (trim(wfilename) /= trim(filename)) then
+       ! filename is open, better match open filename
+       if(pio_iam==0) write(nulprt,*) subname,' different file currently open ',trim(filename)
+       call oasis_abort_noarg()
+    else
+       ! filename is already open, just return
+    endif
+
+end subroutine oasis_ioshr_wopen
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_ioshr_close - close netcdf file
+!
+! !DESCRIPTION:
+!    close netcdf file
+!
+! !REVISION HISTORY:
+!    2007-Oct-26 - T. Craig - initial version
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_ioshr_close(filename)
+
+    implicit none
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    character(*),intent(in) :: filename
+
+    !EOP
+
+    integer :: rcode
+    character(*),parameter :: subName = '(oasis_ioshr_close) '
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+    if (.not. pio_file_is_open(pio_file)) then
+       ! filename not open, just return
+    elseif (trim(wfilename) /= trim(filename)) then
+       ! filename matches, close it
+       call pio_closefile(pio_file)
+    else
+       ! different filename is open, abort
+       if(pio_iam==0) write(nulprt,*) subname,' different file currently open ',trim(filename)
+       call oasis_abortnoarg()
+    endif
+
+    wfilename = ''
+
+end subroutine oasis_ioshr_close
+
+!===============================================================================
+
+subroutine oasis_ioshr_redef(filename)
+    implicit none
+    character(len=*), intent(in) :: filename
+    integer :: rcode
+    character(*),parameter :: subName =   '(oasis_ioshr_redef) '
+
+    rcode = pio_redef(pio_file)
+end subroutine oasis_ioshr_redef
+
+!===============================================================================
+
+subroutine oasis_ioshr_enddef(filename)
+    implicit none
+    character(len=*), intent(in) :: filename
+    integer :: rcode
+    character(*),parameter :: subName =   '(oasis_ioshr_enddef) '
+
+    rcode = pio_enddef(pio_file)
+end subroutine oasis_ioshr_enddef
+
+!===============================================================================
+
+character(len=10) function oasis_ioshr_date2yyyymmdd (date)
+   implicit none
+
+! Input arguments
+
+   integer, intent(in) :: date
+
+! Local workspace
+
+   integer :: year    ! year of yyyy-mm-dd
+   integer :: month   ! month of yyyy-mm-dd
+   integer :: day     ! day of yyyy-mm-dd
+   character(*),parameter :: subName =   '(oasis_ioshr_date2yyyymmdd) '
+
+!-------------------------------------------------------------------------------
+
+   if (date < 0) then
+       WRITE (nulprt,*)  subname,' abort by model ',compid
+       WRITE(nulprt,*) subname,' ERROR: oasis_ioshr_date2yyyymmdd: negative date not allowed'
+       CALL oasis_abort_noarg()
+   end if
+
+   year  = date / 10000
+   month = (date - year*10000) / 100
+   day   = date - year*10000 - month*100
+
+   write(oasis_ioshr_date2yyyymmdd,80) year, month, day
+80 format(i4.4,'-',i2.2,'-',i2.2)
+
+end function oasis_ioshr_date2yyyymmdd
+
+!===============================================================================
+
+character(len=8) function oasis_ioshr_sec2hms (seconds)
+   implicit none
+
+! Input arguments
+
+   integer, intent(in) :: seconds
+
+! Local workspace
+
+   integer :: hours     ! hours of hh:mm:ss
+   integer :: minutes   ! minutes of hh:mm:ss
+   integer :: secs      ! seconds of hh:mm:ss
+   character(*),parameter :: subName =   '(oasis_ioshr_sec2hms) '
+
+!-------------------------------------------------------------------------------
+
+   if (seconds < 0 .or. seconds > 86400) then
+       WRITE (nulprt,*)  subname,' abort by model ',compid
+       WRITE(nulprt,*) subname,'oasis_ioshr_sec2hms: bad input seconds:', seconds
+       CALL oasis_abort_noarg()
+   end if
+
+   hours   = seconds / 3600
+   minutes = (seconds - hours*3600) / 60
+   secs    = (seconds - hours*3600 - minutes*60)
+
+   if (minutes < 0 .or. minutes > 60) then
+       WRITE (nulprt,*)  subname,' abort by model ',compid
+       WRITE(nulprt,*) subname,'oasis_ioshr_sec2hms: bad minutes = ',minutes
+       CALL oasis_abort_noarg()
+   end if
+
+   if (secs < 0 .or. secs > 60) then
+       WRITE (nulprt,*)  subname,' abort by model ',compid
+       WRITE(nulprt,*) subname,'oasis_ioshr_sec2hms: bad secs = ',secs
+       CALL oasis_abort_noarg()
+   end if
+
+   write(oasis_ioshr_sec2hms,80) hours, minutes, secs
+80 format(i2.2,':',i2.2,':',i2.2)
+
+end function oasis_ioshr_sec2hms
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_ioshr_write_av - write AV to netcdf file
+!
+! !DESCRIPTION:
+!    Write AV to netcdf file
+!
+! !REVISION HISTORY:
+!    2007-Oct-26 - T. Craig - initial version
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_av(filename,gsmap,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,use_float)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    type(mct_gsMap), intent(in) :: gsmap
+    type(mct_aVect) ,intent(in) :: AV       ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+    integer(in),optional,intent(in) :: nx   ! 2d grid size if available
+    integer(in),optional,intent(in) :: ny   ! 2d grid size if available
+    integer(in),optional,intent(in) :: nt   ! time sample
+    real(r8),optional,intent(in) :: fillval ! fill value
+    character(len=*),optional,intent(in) :: pre      ! prefix to variable name
+    logical,optional,intent(in) :: tavg     ! is this a tavg
+    logical,optional,intent(in) :: use_float ! write output as float rather than double
+
+    !EOP
+
+    integer(in) :: rcode
+    integer(in) :: nf,ns,ng
+    integer(in) :: i,j,k,n
+    integer(in),target  :: dimid2(2)
+    integer(in),target  :: dimid3(3)
+    integer(in),pointer :: dimid(:)
+    type(var_desc_t) :: varid
+    type(io_desc_t) :: iodesc
+    integer(kind=PIO_OffSet) :: frame
+    type(mct_string) :: mstring     ! mct char type
+    character(CL)    :: itemc       ! string converted to char
+    character(CL)    :: name1       ! var name
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    character(CL)    :: lpre        ! local prefix
+    logical :: exists
+    logical :: lwhead, lwdata
+    integer(in) :: lnx,lny
+    real(r8) :: lfillvalue
+    type(mct_aVect) :: AVroot
+    real(r8),pointer :: fld1(:,:)  ! needed to convert AVroot ng rAttr to 2d nx,ny
+    character(*),parameter :: subName = '(oasis_ioshr_write_av) '
+    integer :: lbnum
+    integer, pointer :: Dof(:)
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lfillvalue = fillvalue
+    if (present(fillval)) then
+       lfillvalue = fillval
+    endif
+
+    lpre = trim(dname)
+    if (present(pre)) then
+       lpre = trim(pre)
+    endif
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    ng = mct_gsmap_gsize(gsmap)
+    lnx = ng
+    lny = 1
+	
+    nf = mct_aVect_nRattr(AV)
+    if (nf < 1) then
+       WRITE (nulprt,*)  subname,' abort by model ',compid
+       write(nulprt,*) subname,' ERROR: nf = ',nf,trim(dname)
+       call oasis_abort_noarg()
+    endif
+
+    if (present(nx)) then
+       if (nx /= 0) lnx = nx
+    endif
+    if (present(ny)) then
+       if (ny /= 0) lny = ny
+    endif
+    if (lnx*lny /= ng) then
+       if(pio_iam==0) WRITE (nulprt,*)  subname,' abort by model ',compid
+       if(pio_iam==0) write(nulprt,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny,trim(dname)
+       call oasis_abort_noarg()
+    endif
+
+    if (lwhead) then
+       rcode = pio_def_dim(pio_file,trim(lpre)//'_nx',lnx,dimid2(1))
+       rcode = pio_def_dim(pio_file,trim(lpre)//'_ny',lny,dimid2(2))
+
+       if (present(nt)) then
+          dimid3(1:2) = dimid2
+          rcode = pio_inq_dimid(pio_file,'time',dimid3(3))
+          dimid => dimid3
+       else
+          dimid => dimid2
+       endif
+
+       do k = 1,nf
+          call mct_aVect_getRList(mstring,k,AV)
+          itemc = mct_string_toChar(mstring)
+          call mct_string_clean(mstring)
+! "v0"    name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
+          name1 = trim(lpre)//'_'//trim(itemc)
+          call oasis_ioshr_flds_lookup(itemc,longname=lname,stdname=sname,units=cunit)
+	  if (present(use_float)) then 
+             rcode = pio_def_var(pio_file,trim(name1),PIO_REAL,dimid,varid)
+          else
+             rcode = pio_def_var(pio_file,trim(name1),PIO_DOUBLE,dimid,varid)
+          end if
+          rcode = pio_put_att(pio_file,varid,"_FillValue",lfillvalue)
+          rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+          rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+          rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+          rcode = pio_put_att(pio_file,varid,"internal_dname",trim(dname))
+          if (present(tavg)) then
+             if (tavg) then
+                rcode = pio_put_att(pio_file,varid,"cell_methods","time: mean")
+             endif
+          endif
+       enddo
+       if (lwdata) call oasis_ioshr_enddef(filename)
+    end if
+
+    if (lwdata) then
+       call mct_gsmap_OrderedPoints(gsmap, pio_iam, Dof)
+       call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
+       deallocate(dof)
+
+       do k = 1,nf
+          call mct_aVect_getRList(mstring,k,AV)
+          itemc = mct_string_toChar(mstring)
+          call mct_string_clean(mstring)
+! "v0"    name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
+          name1 = trim(lpre)//'_'//trim(itemc)
+          rcode = pio_inq_varid(pio_file,trim(name1),varid)
+          if (present(nt)) then
+             frame = nt
+          else
+             frame = 1
+          endif
+          call pio_setframe(varid,frame)
+          call pio_write_darray(pio_file, varid, iodesc, av%rattr(k,:), rcode, fillval=lfillvalue)
+       enddo
+
+       call pio_freedecomp(pio_file, iodesc)
+
+    end if
+  end subroutine oasis_ioshr_write_av
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_write_int - write scalar integer to netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Write scalar integer to netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_int(filename,idata,dname,whead,wdata)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    integer(in)     ,intent(in) :: idata    ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+
+    !EOP
+
+    integer(in) :: rcode
+    type(var_desc_t) :: varid
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    logical :: exists
+    logical :: lwhead, lwdata
+    character(*),parameter :: subName = '(oasis_ioshr_write_int) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    if (lwhead) then
+       call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
+!       rcode = pio_def_dim(pio_file,trim(dname)//'_nx',1,dimid(1))
+!       rcode = pio_def_var(pio_file,trim(dname),PIO_INT,dimid,varid)
+       rcode = pio_def_var(pio_file,trim(dname),PIO_INT,varid)
+       rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+       rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+       rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+       if (lwdata) call oasis_ioshr_enddef(filename)
+    endif
+
+    if (lwdata) then
+       rcode = pio_inq_varid(pio_file,trim(dname),varid)
+       rcode = pio_put_var(pio_file,varid,idata)
+
+       !      write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
+    endif
+
+  end subroutine oasis_ioshr_write_int
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_write_int1d - write 1d integer array to netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Write 1d integer array to netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_int1d(filename,idata,dname,whead,wdata)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    integer(in)     ,intent(in) :: idata(:) ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+
+    !EOP
+
+    integer(in) :: rcode
+    integer(in) :: dimid(1)
+    type(var_desc_t) :: varid
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    integer(in) :: lnx
+    logical :: exists
+    logical :: lwhead, lwdata
+    character(*),parameter :: subName = '(oasis_ioshr_write_int1d) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    if (lwhead) then
+       call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
+       lnx = size(idata)
+       rcode = pio_def_dim(pio_file,trim(dname)//'_nx',lnx,dimid(1))
+       rcode = pio_def_var(pio_file,trim(dname),PIO_INT,dimid,varid)
+       rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+       rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+       rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+       if (lwdata) call oasis_ioshr_enddef(filename)
+    endif
+
+    if (lwdata) then
+       rcode = pio_inq_varid(pio_file,trim(dname),varid)
+       rcode = pio_put_var(pio_file,varid,idata)
+    endif
+
+       !      write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
+
+  end subroutine oasis_ioshr_write_int1d
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_write_r8 - write scalar double to netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Write scalar double to netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_r8(filename,rdata,dname,whead,wdata)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    real(r8)        ,intent(in) :: rdata    ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+
+    !EOP
+
+    integer(in) :: rcode
+    type(var_desc_t) :: varid
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    logical :: exists
+    logical :: lwhead, lwdata
+    character(*),parameter :: subName = '(oasis_ioshr_write_r8) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    if (lwhead) then
+       call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
+!       rcode = pio_def_dim(pio_file,trim(dname)//'_nx',1,dimid(1))
+!       rcode = pio_def_var(pio_file,trim(dname),PIO_DOUBLE,dimid,varid)
+
+
+       rcode = pio_def_var(pio_file,trim(dname),PIO_DOUBLE,varid)
+       if(rcode==PIO_NOERR) then
+          rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+          rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+          rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+          if (lwdata) call oasis_ioshr_enddef(filename)
+       end if
+    endif
+
+    if (lwdata) then
+       rcode = pio_inq_varid(pio_file,trim(dname),varid)
+       rcode = pio_put_var(pio_file,varid,rdata)
+    endif
+
+
+  end subroutine oasis_ioshr_write_r8
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_write_r81d - write 1d double array to netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Write 1d double array to netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_r81d(filename,rdata,dname,whead,wdata)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    real(r8)        ,intent(in) :: rdata(:) ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+
+    !EOP
+
+    integer(in) :: rcode
+    integer(in) :: dimid(1)
+    type(var_desc_t) :: varid
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    integer(in) :: lnx
+    logical :: exists
+    logical :: lwhead, lwdata
+    character(*),parameter :: subName = '(oasis_ioshr_write_r81d) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    if (lwhead) then
+       call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
+       lnx = size(rdata)
+       rcode = pio_def_dim(pio_file,trim(dname)//'_nx',lnx,dimid(1))
+       rcode = pio_def_var(pio_file,trim(dname),PIO_DOUBLE,dimid,varid)
+       rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+       rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+       rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+       if (lwdata) call oasis_ioshr_enddef(filename)
+    endif
+
+    if (lwdata) then
+       rcode = pio_inq_varid(pio_file,trim(dname),varid)
+       rcode = pio_put_var(pio_file,varid,rdata)
+
+       !      write(nulprt,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
+    endif
+
+  end subroutine oasis_ioshr_write_r81d
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_write_char - write char string to netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Write char string to netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2010-July-06 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_write_char(filename,rdata,dname,whead,wdata)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    character(len=*),intent(in) :: rdata    ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    logical,optional,intent(in) :: whead    ! write header
+    logical,optional,intent(in) :: wdata    ! write data
+
+    !EOP
+
+    integer(in) :: rcode
+    integer(in) :: dimid(1)
+    type(var_desc_t) :: varid
+    character(CL)    :: cunit       ! var units
+    character(CL)    :: lname       ! long name
+    character(CL)    :: sname       ! standard name
+    integer(in) :: lnx
+    logical :: exists
+    logical :: lwhead, lwdata
+    character(*),parameter :: subName = '(oasis_ioshr_write_char) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lwhead = .true.
+    lwdata = .true.
+    if (present(whead)) lwhead = whead
+    if (present(wdata)) lwdata = wdata
+
+    if (.not.lwhead .and. .not.lwdata) then
+       ! should we write a warning?
+       return
+    endif
+
+    if (lwhead) then
+       call oasis_ioshr_flds_lookup(trim(dname),longname=lname,stdname=sname,units=cunit)
+       lnx = len(charvar)
+       rcode = pio_def_dim(pio_file,trim(dname)//'_len',lnx,dimid(1))
+       rcode = pio_def_var(pio_file,trim(dname),PIO_CHAR,dimid,varid)
+       rcode = pio_put_att(pio_file,varid,"units",trim(cunit))
+       rcode = pio_put_att(pio_file,varid,"long_name",trim(lname))
+       rcode = pio_put_att(pio_file,varid,"standard_name",trim(sname))
+       if (lwdata) call oasis_ioshr_enddef(filename)
+    endif
+
+    if (lwdata) then
+       charvar = ''
+       charvar = trim(rdata)
+       rcode = pio_inq_varid(pio_file,trim(dname),varid)
+       rcode = pio_put_var(pio_file,varid,charvar)
+    endif
+
+  end subroutine oasis_ioshr_write_char
+
+  !===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_ioshr_write_time - write time variable to netcdf file
+!
+! !DESCRIPTION:
+!    Write time variable to netcdf file
+!
+! !REVISION HISTORY:
+!    2009-Feb-11 - M. Vertenstein - initial version
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_ioshr_write_time(filename,time_units,time_cal,time_val,nt,whead,wdata,tbnds)
+
+! !INPUT/OUTPUT PARAMETERS:
+   implicit none
+   character(len=*),intent(in) :: filename      ! file
+   character(len=*),intent(in) :: time_units    ! units of time
+   character(len=*),intent(in) :: time_cal      ! calendar type
+   real(r8)        ,intent(in) :: time_val      ! data to be written
+   integer(in),optional,intent(in) :: nt
+   logical,optional,intent(in) :: whead         ! write header
+   logical,optional,intent(in) :: wdata         ! write data
+   real(r8),optional,intent(in) :: tbnds(2)     ! time bounds
+
+!EOP
+
+   integer(in) :: rcode
+   integer(in) :: dimid(1)
+   integer(in) :: dimid2(2)
+   type(var_desc_t) :: varid
+   integer(in) :: lnx
+   logical :: exists
+   logical :: lwhead, lwdata
+   integer :: start(4),count(4)
+   character(len=CL) :: lcalendar
+   real(r8) :: time_val_1d(1)
+   character(*),parameter :: subName = '(oasis_ioshr_write_time) '
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   lwhead = .true.
+   lwdata = .true.
+   if (present(whead)) lwhead = whead
+   if (present(wdata)) lwdata = wdata
+
+   if (.not.lwhead .and. .not.lwdata) then
+      ! should we write a warning?
+      return
+   endif
+
+   if (lwhead) then
+      rcode = pio_def_dim(pio_file,'time',PIO_UNLIMITED,dimid(1))
+      rcode = pio_def_var(pio_file,'time',PIO_DOUBLE,dimid,varid)
+      rcode = pio_put_att(pio_file,varid,'units',trim(time_units))
+      lcalendar = 'noleap'
+      rcode = pio_put_att(pio_file,varid,'calendar',trim(lcalendar))
+      if (present(tbnds)) then
+         rcode = pio_put_att(pio_file,varid,'bounds','time_bnds')
+         dimid2(2)=dimid(1)
+         rcode = pio_def_dim(pio_file,'ntb',2,dimid2(1))
+         rcode = pio_def_var(pio_file,'time_bnds',PIO_DOUBLE,dimid2,varid)
+      endif
+      if (lwdata) call oasis_ioshr_enddef(filename)
+   endif
+
+   if (lwdata) then
+      start = 1
+      count = 1
+      if (present(nt)) then
+         start(1) = nt
+      endif
+      time_val_1d(1) = time_val
+      rcode = pio_inq_varid(pio_file,'time',varid)
+      rcode = pio_put_var(pio_file,varid,start,count,time_val_1d)
+      if (present(tbnds)) then
+         rcode = pio_inq_varid(pio_file,'time_bnds',varid)
+         start = 1
+         count = 1
+         if (present(nt)) then
+            start(2) = nt
+         endif
+         count(1) = 2
+         rcode = pio_put_var(pio_file,varid,start,count,tbnds)
+      endif
+
+      !      write(nulprt,*) subname,' wrote time ',lwhead,lwdata
+   endif
+
+ end subroutine oasis_ioshr_write_time
+
+!===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_av - read AV from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read AV from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_av(filename,gsmap,AV,dname,pre)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    type(mct_gsMap), intent(in) :: gsmap
+    type(mct_aVect) ,intent(inout):: AV     ! data to be written
+    character(len=*),intent(in) :: dname    ! name of data
+    character(len=*),intent(in),optional :: pre      ! prefix name
+
+    !EOP
+
+    integer(in) :: rcode
+    integer(in) :: nf,ns,ng
+    integer(in) :: i,j,k,n, ndims
+    type(file_desc_t) :: pioid
+    integer(in) :: dimid(2)
+    type(var_desc_t) :: varid
+    integer(in) :: lnx,lny
+    type(mct_string) :: mstring     ! mct char type
+    character(CL)    :: itemc       ! string converted to char
+    logical :: exists
+    type(io_desc_t) :: iodesc
+    integer(in), pointer :: dof(:)
+    character(CL)  :: lversion
+    character(CL)  :: name1
+    character(CL)  :: lpre
+    character(*),parameter :: subName = '(oasis_ioshr_read_av) '
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    lpre = trim(dname)
+    if (present(pre)) then
+       lpre = trim(pre)
+    endif
+
+    call mct_gsmap_OrderedPoints(gsmap, pio_iam, Dof)
+
+    ns = mct_aVect_lsize(AV)
+    nf = mct_aVect_nRattr(AV)
+
+    if (pio_iam==0) inquire(file=trim(filename),exist=exists)
+    call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_av exists')
+    if (exists) then
+       rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
+       if(pio_iam==0) write(nulprt,*) subname,' open file ',trim(filename)
+       call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
+       rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
+       call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
+    else
+       if(pio_iam==0) WRITE (nulprt,*)  subname,' abort by model ',compid
+       if(pio_iam==0) write(nulprt,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
+       call oasis_abort_noarg()
+    endif
+
+    do k = 1,nf
+       call mct_aVect_getRList(mstring,k,AV)
+       itemc = mct_string_toChar(mstring)
+       call mct_string_clean(mstring)
+       name1 = trim(lpre)//'_'//trim(itemc)
+       call pio_seterrorhandling(pioid, PIO_BCAST_ERROR)
+       rcode = pio_inq_varid(pioid,trim(name1),varid)
+       if (rcode == pio_noerr) then
+          if (k==1) then
+             rcode = pio_inq_varndims(pioid, varid, ndims)
+             rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims))
+             rcode = pio_inq_dimlen(pioid, dimid(1), lnx)
+             if (ndims==2) then
+                rcode = pio_inq_dimlen(pioid, dimid(2), lny)
+             else
+                lny = 1
+             end if
+             ng = lnx * lny
+             if (ng /= mct_gsmap_gsize(gsmap)) then
+                 IF (pio_iam==0) WRITE (nulprt,*)  subname,' abort by model ',compid
+                 IF (pio_iam==0) WRITE(nulprt,*) subname,' ERROR: dimensions do not match',&
+                     lnx,lny,mct_gsmap_gsize(gsmap)
+                 CALL oasis_abort_noarg()
+             end if
+             call pio_initdecomp(pio_iosystem, pio_double, (/lnx,lny/), dof, iodesc)
+             deallocate(dof)
+          end if
+          call pio_read_darray(pioid,varid,iodesc, av%rattr(k,:), rcode)
+       else
+          write(nulprt,*)'oasis_ioshr_readav warning: field ',trim(itemc),' is not on restart file'
+          write(nulprt,*)'for backwards compatibility will set it to 0'
+          av%rattr(k,:) = 0.0_r8
+       end if
+       call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
+          
+       !--- zero out fill value, this is somewhat arbitrary
+       do n = 1,ns
+          if (AV%rAttr(k,n) == fillvalue) then
+              AV%rAttr(k,n) = 0.0_r8
+          endif
+       enddo
+    enddo
+
+    call pio_freedecomp(pioid, iodesc)
+    call pio_closefile(pioid)
+
+  end subroutine oasis_ioshr_read_av
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_int - read scalar integer from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read scalar integer from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_int(filename,idata,dname)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    integer         ,intent(inout):: idata  ! integer data
+    character(len=*),intent(in) :: dname    ! name of data
+
+    !EOP
+
+    integer :: i1d(1)
+    character(*),parameter :: subName = '(oasis_ioshr_read_int) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    call oasis_ioshr_read_int1d(filename,i1d,dname)
+    idata = i1d(1)
+
+  end subroutine oasis_ioshr_read_int
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_int1d - read 1d integer from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read 1d integer array from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_int1d(filename,idata,dname)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    integer(in)     ,intent(inout):: idata(:)  ! integer data
+    character(len=*),intent(in) :: dname    ! name of data
+
+    !EOP
+
+    integer(in) :: rcode
+    type(file_desc_t) :: pioid 
+    type(var_desc_t) :: varid
+    logical :: exists
+    character(CL)  :: lversion
+    character(CL)  :: name1
+    character(*),parameter :: subName = '(oasis_ioshr_read_int1d) '
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    if (pio_iam==0) inquire(file=trim(filename),exist=exists)
+    call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_int1d exists')
+    if (exists) then
+       rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
+       !         write(nulprt,*) subname,' open file ',trim(filename)
+       call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
+       rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
+       call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
+    else
+        IF(pio_iam==0) WRITE (nulprt,*)  subname,' abort by model ',compid
+        IF(pio_iam==0) WRITE(nulprt,*) subname,' ERROR: file invalid ',TRIM(filename),' ',TRIM(dname)
+        CALL oasis_abort_noarg()
+    endif
+
+    name1 = trim(dname)
+    rcode = pio_inq_varid(pioid,trim(name1),varid)
+    rcode = pio_get_var(pioid,varid,idata)
+
+    call pio_closefile(pioid)
+
+    !      write(nulprt,*) subname,' read int ',trim(dname)
+
+
+  end subroutine oasis_ioshr_read_int1d
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_r8 - read scalar double from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read scalar double from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_r8(filename,rdata,dname)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    real(r8)        ,intent(inout):: rdata  ! real data
+    character(len=*),intent(in) :: dname    ! name of data
+
+    !EOP
+
+    real(r8) :: r1d(1)
+    character(*),parameter :: subName = '(oasis_ioshr_read_r8) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    call oasis_ioshr_read_r81d(filename,r1d,dname)
+    rdata = r1d(1)
+
+  end subroutine oasis_ioshr_read_r8
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_r81d - read 1d double array from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read 1d double array from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2007-Oct-26 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_r81d(filename,rdata,dname)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    real(r8)        ,intent(inout):: rdata(:)  ! real data
+    character(len=*),intent(in) :: dname    ! name of data
+
+    !EOP
+
+    integer(in) :: rcode
+    type(file_desc_T) :: pioid 
+    type(var_desc_t) :: varid
+    logical :: exists
+    character(CL)  :: lversion
+    character(CL)  :: name1
+    character(*),parameter :: subName = '(oasis_ioshr_read_r81d) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    if (pio_iam==0) inquire(file=trim(filename),exist=exists)
+    call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_r81d exists')
+    if (exists) then
+       rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
+       !         write(nulprt,*) subname,' open file ',trim(filename)
+       call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
+       rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
+       call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
+    else
+        IF(pio_iam==0) WRITE (nulprt,*)  subname,' abort by model ',compid
+        IF(pio_iam==0) WRITE(nulprt,*) subname,' ERROR: file invalid ',TRIM(filename),' ',TRIM(dname)
+        CALL oasis_abort_noarg()
+    endif
+
+    name1 = trim(dname)
+    rcode = pio_inq_varid(pioid,trim(name1),varid)
+    rcode = pio_get_var(pioid,varid,rdata)
+
+    call pio_closefile(pioid)
+
+    !      write(nulprt,*) subname,' read int ',trim(dname)
+
+  end subroutine oasis_ioshr_read_r81d
+
+  !===============================================================================
+  !BOP ===========================================================================
+  !
+  ! !IROUTINE: oasis_ioshr_read_char - read char string from netcdf file
+  !
+  ! !DESCRIPTION:
+  !    Read char string from netcdf file
+  !
+  ! !REVISION HISTORY:
+  !    2010-July-06 - T. Craig - initial version
+  !
+  ! !INTERFACE: ------------------------------------------------------------------
+
+  subroutine oasis_ioshr_read_char(filename,rdata,dname)
+
+    ! !INPUT/OUTPUT PARAMETERS:
+    implicit none
+    character(len=*),intent(in) :: filename ! file
+    character(len=*),intent(inout):: rdata  ! character data
+    character(len=*),intent(in) :: dname    ! name of data
+
+    !EOP
+
+    integer(in) :: rcode
+    type(file_desc_T) :: pioid 
+    type(var_desc_t) :: varid
+    logical :: exists
+    character(CL)  :: lversion
+    character(CL)  :: name1
+    character(*),parameter :: subName = '(oasis_ioshr_read_char) '
+
+    !-------------------------------------------------------------------------------
+    !
+    !-------------------------------------------------------------------------------
+
+    if (pio_iam==0) inquire(file=trim(filename),exist=exists)
+    call oasis_mpi_bcast(exists,pio_mpicomm,'oasis_ioshr_read_char exists')
+    if (exists) then
+       rcode = pio_openfile(pio_iosystem, pioid, pio_iotype, trim(filename),pio_nowrite)
+       !         write(nulprt,*) subname,' open file ',trim(filename)
+       call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
+       rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
+       call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
+    else
+        IF(pio_iam==0)WRITE (nulprt,*)  subname,' abort by model ',compid
+        IF(pio_iam==0) WRITE(nulprt,*) subname,' ERROR: file invalid ',TRIM(filename),' ',TRIM(dname)
+        CALL oasis_abort_noarg()
+    endif
+
+    name1 = trim(dname)
+    rcode = pio_inq_varid(pioid,trim(name1),varid)
+    rcode = pio_get_var(pioid,varid,charvar)
+    rdata = trim(charvar)
+
+    call pio_closefile(pioid)
+
+  end subroutine oasis_ioshr_read_char
+
+#endif
+  !===============================================================================
+!===============================================================================
+end module mod_oasis_ioshr
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_kinds.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_kinds.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_kinds.F90	(revision 4775)
@@ -0,0 +1,48 @@
+!-------------------------------------------------------------------
+! BOP
+!
+! !MODULE: mod_oasis_kinds
+MODULE mod_oasis_kinds
+!
+! !USES:
+!
+! !PUBLIC TYPES:
+IMPLICIT NONE
+public
+SAVE
+!
+! !PUBLIC MEMBER FUNCTIONS:
+!
+! !PARAMETERS:
+  INTEGER, PARAMETER :: ic_lvar = 128
+  INTEGER, PARAMETER :: ic_sm   = 8
+  INTEGER, PARAMETER :: ic_med  = 64
+  INTEGER, PARAMETER :: ic_long = 256
+  INTEGER, PARAMETER :: ic_xl   = 1024
+  INTEGER, PARAMETER :: ic_field = 1000
+  INTEGER, PARAMETER :: ip_single_p = SELECTED_REAL_KIND(6,37)
+  INTEGER, PARAMETER :: ip_double_p = SELECTED_REAL_KIND(12,307)
+  INTEGER, PARAMETER :: ip_realwp_p = ip_double_p
+  LOGICAL, PARAMETER :: ll_single = .FALSE.  
+  INTEGER, PARAMETER :: ip_i2_p = SELECTED_INT_KIND(4)
+  INTEGER, PARAMETER :: ip_i4_p = SELECTED_INT_KIND(9)
+#ifdef SX
+  INTEGER, PARAMETER :: ip_i8_p = SELECTED_INT_KIND(15)
+#else
+  INTEGER, PARAMETER :: ip_i8_p = SELECTED_INT_KIND(18)
+#endif
+  INTEGER, PARAMETER :: ip_intwp_p = ip_i4_p 
+  INTEGER, PARAMETER :: ip_r8_p = ip_double_p
+!
+! !PUBLIC DATA MEMBERS:
+!
+  INTEGER(kind=ip_intwp_p)  :: nulprt, nulprt1
+  INTEGER(kind=ip_i4_p)	    :: OASIS_debug
+  INTEGER(kind=ip_i4_p)     :: TIMER_debug
+!
+! !DESCRIPTION:
+! This modules contains the parameters defining the precision used for 
+! real and integer variables
+!   
+END MODULE mod_oasis_kinds
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_method.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_method.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_method.F90	(revision 4775)
@@ -0,0 +1,720 @@
+MODULE mod_oasis_method
+
+   USE mod_oasis_kinds
+   USE mod_oasis_sys
+   USE mod_oasis_data
+   USE mod_oasis_parameters
+   USE mod_oasis_namcouple
+   USE mod_oasis_coupler
+   USE mod_oasis_advance
+   USE mod_oasis_timer
+   USE mod_oasis_ioshr
+   USE mod_oasis_grid
+   USE mod_oasis_mpi
+   USE mod_oasis_string
+   USE mct_mod
+
+   IMPLICIT NONE
+
+   private
+
+   public oasis_init_comp
+   public oasis_terminate
+   public oasis_get_localcomm
+   public oasis_set_couplcomm
+   public oasis_create_couplcomm
+   public oasis_get_debug
+   public oasis_set_debug
+   public oasis_get_intercomm
+   public oasis_get_intracomm
+   public oasis_enddef
+
+#ifdef __VERBOSE
+   integer(kind=ip_intwp_p),parameter :: debug=2
+#else
+   integer(kind=ip_intwp_p),parameter :: debug=1
+#endif
+   logical,save :: lg_mpiflag
+
+CONTAINS
+
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_init_comp(mynummod,cdnam,kinfo)
+
+   ! This is COLLECTIVE, all pes must call
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(out)   :: mynummod     
+   CHARACTER(len=*)         ,intent(in)    :: cdnam
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   integer(kind=ip_intwp_p) :: mpi_err
+   INTEGER(kind=ip_intwp_p) :: n,nns,iu
+   integer(kind=ip_intwp_p) :: icolor,ikey
+   CHARACTER(len=ic_med)    :: filename,filename2
+   character(len=ic_med)    :: pio_type
+   integer(kind=ip_intwp_p) :: pio_stride
+   integer(kind=ip_intwp_p) :: pio_root
+   integer(kind=ip_intwp_p) :: pio_numtasks
+   INTEGER(kind=ip_intwp_p),ALLOCATABLE :: tmparr(:)
+   INTEGER(kind=ip_intwp_p) :: k,i,m
+   INTEGER(kind=ip_intwp_p) :: nt
+   character(len=ic_field)  :: i_name
+   character(len=*),parameter :: subname = 'oasis_init_comp'
+!  ---------------------------------------------------------
+
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+   call oasis_data_zero()
+
+   !------------------------
+   !--- Initialize MPI
+   !------------------------
+
+   lg_mpiflag = .FALSE.
+   CALL MPI_Initialized ( lg_mpiflag, mpi_err )
+   IF ( .NOT. lg_mpiflag ) THEN
+      if (OASIS_debug >= 0) WRITE (0,FMT='(A)') subname//': Calling MPI_Init'
+      CALL MPI_INIT ( mpi_err )
+   else
+      if (OASIS_debug >= 0) WRITE (0,FMT='(A)') subname//': Not Calling MPI_Init'
+   ENDIF
+
+#ifdef use_comm_MPI1
+   mpi_comm_global = MPI_COMM_WORLD
+#elif defined use_comm_MPI2
+   mpi_comm_global = ??
+#endif
+
+   CALL MPI_Comm_Size(mpi_comm_global,mpi_size_global,mpi_err)
+   CALL MPI_Comm_Rank(mpi_comm_global,mpi_rank_global,mpi_err)
+
+   !------------------------
+   !--- nout file, need mpi_rank_global
+   !------------------------
+
+   iu=-1
+
+   call oasis_unitsetmin(1024)
+   IF (mpi_rank_global == 0) THEN
+       CALL oasis_unitget(iu)
+       nulprt1 = iu
+       WRITE(filename,'(a,i6.6)') 'nout.',mpi_rank_global
+       OPEN(nulprt1,file=filename)
+   ENDIF
+
+   !------------------------
+   !--- Initialize namcouple
+   !--- first on rank 0 to write error messages
+   !--- then on all other ranks
+   !------------------------
+
+   IF (mpi_rank_global == 0) THEN
+      call oasis_namcouple_init()
+   endif
+   call oasis_mpi_barrier(mpi_comm_global)
+   IF (mpi_rank_global /= 0) THEN
+      call oasis_namcouple_init()
+   endif
+   OASIS_debug = namlogprt
+   TIMER_debug = namtlogprt
+
+   ! If NFIELDS=0 there is no coupling
+   ! No information must be written in the debug files as
+   ! the different structures are not allocated
+   !
+   IF ( nnamcpl == 0 ) THEN
+       IF (mpi_rank_global == 0) THEN
+           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' The models are not exchanging any field ($NFIELDS = 0) '
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' so we force OASIS_debug = 0 for all processors '
+           OASIS_debug = 0
+           CALL oasis_flush(nulprt1)
+       ENDIF
+   ENDIF
+
+   ! Determines the total number of fields to avoid a parameter in oasis_def_var
+   ! and mod_oasis_coupler
+   mvar=0
+   DO nns = 1,nnamcpl
+     n = namfldsort(nns)
+     mvar = mvar + oasis_string_listGetNum(namsrcfld(n))
+   ENDDO
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) 'Total number of coupling fields :',mvar
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+   ALLOCATE(prism_var(mvar))
+
+   ! Store all the names of the fields exchanged in the namcouple
+   ! which can be different of namsrcfld(:) and namdstfld(:) if multiple 
+   ! fields are exchanged together
+   ALLOCATE(total_namsrcfld(mvar))
+   ALLOCATE(total_namdstfld(mvar))
+   m=0
+   DO nns = 1,nnamcpl
+     n = namfldsort(nns)
+     k=oasis_string_listGetNum(namsrcfld(n))
+     DO i=1,k 
+       m=m+1
+       CALL oasis_string_listGetName(namsrcfld(n),i,i_name)
+       total_namsrcfld(m)=trim(i_name)
+     ENDDO
+   ENDDO
+   !
+   m=0
+   DO nns = 1,nnamcpl
+     n = namfldsort(nns)
+     k=oasis_string_listGetNum(namdstfld(n))
+     DO i=1,k 
+       m=m+1
+       CALL oasis_string_listGetName(namdstfld(n),i,i_name)
+       total_namdstfld(m)=trim(i_name)
+     ENDDO
+   ENDDO
+   DO m=1,mvar
+     IF (mpi_rank_global == 0) THEN
+         WRITE (UNIT = nulprt1,FMT = *) subname,'Coupling fields  namsrcfld:',&
+                                     TRIM(total_namsrcfld(m))
+         WRITE (UNIT = nulprt1,FMT = *) subname,'Coupling fields namdstfld:',&
+                                     TRIM(total_namdstfld(m))
+         CALL oasis_flush(nulprt1)
+     ENDIF
+   ENDDO
+
+   !
+   !------------------------
+   !--- Set compid (need namcouple model names)
+   !------------------------
+
+   compid = -1
+   compnm = trim(cdnam)
+   do n = 1,prism_nmodels
+      if (trim(cdnam) == trim(prism_modnam(n))) compid = n
+   enddo
+   mynummod = compid
+   IF (mpi_rank_global == 0) THEN
+       WRITE(nulprt1,*) subname, 'cdnam :',TRIM(cdnam),' mynummod :',mynummod
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+   if (compid < 0) then
+       IF (mpi_rank_global == 0) THEN
+           WRITE(nulprt1,*) subname,' model not found in namcouple ',&
+                            TRIM(cdnam)
+           CALL oasis_flush(nulprt1)
+       ENDIF
+       CALL oasis_abort_noarg()
+   endif
+
+
+   !------------------------
+   !--- Re-Set MPI info (need compid for MPI1 COMM_SPLIT)
+   !------------------------
+
+#ifdef use_comm_MPI1
+
+   mpi_comm_global = MPI_COMM_WORLD
+   ikey = compid
+   icolor = compid
+   call MPI_COMM_SPLIT(MPI_COMM_WORLD,icolor,ikey,mpi_comm_local,mpi_err)
+
+#elif defined use_comm_MPI2
+
+   mpi_comm_global = ??
+   mpi_comm_local = MPI_COMM_WORLD
+
+#endif
+
+!------------------------------------
+
+   CALL MPI_Comm_Size(mpi_comm_global,mpi_size_global,mpi_err)
+   CALL MPI_Comm_Rank(mpi_comm_global,mpi_rank_global,mpi_err)
+
+   CALL MPI_Comm_Size(mpi_comm_local,mpi_size_local,mpi_err)
+   CALL MPI_Comm_Rank(mpi_comm_local,mpi_rank_local,mpi_err)
+   mpi_root_local = 0
+
+   !------------------------
+   !--- derive mpi_root_global
+   !------------------------
+
+   allocate(mpi_root_global(prism_nmodels))
+   allocate(tmparr(prism_nmodels))
+   tmparr = -1
+   do n = 1,prism_nmodels
+      if (compid == n .and. &
+          mpi_rank_local == mpi_root_local) then
+         tmparr(n) = mpi_rank_global
+      endif
+   enddo
+   call oasis_mpi_max(tmparr,mpi_root_global,MPI_COMM_WORLD, &
+      string=subname//':mpi_root_global',all=.true.)
+   deallocate(tmparr)
+
+   IF (mpi_rank_global == 0) THEN
+       DO n = 1,prism_nmodels
+         WRITE(nulprt1,*) subname,'   n,prism_model,root = ',&
+            n,TRIM(prism_modnam(n)),mpi_root_global(n)
+       ENDDO
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+   do n = 1,prism_nmodels
+      IF (mpi_root_global(n) < 0) THEN
+          IF (mpi_rank_global == 0) THEN
+              WRITE(nulprt1,*) subname,'   n,prism_model,root = ',&
+                 n,TRIM(prism_modnam(n)),mpi_root_global(n)
+              WRITE(nulprt1,*) subname,' ERROR: global root invalid, &
+                 & check couplcomm for active tasks'
+              CALL oasis_flush(nulprt1)
+              CALL oasis_abort_noarg()
+          ENDIF
+      ENDIF
+   enddo
+
+#if defined balance
+   ! CPP key balance incompatible with OASIS_Debug < 2
+   IF ( OASIS_debug < 2 ) THEN
+      WRITE (UNIT = nulprt1,FMT = *) '        ***ABORT***'
+      WRITE (UNIT = nulprt1,FMT = *)  &
+       ' With load balance CPP option (-Dbalance) '
+      WRITE (UNIT = nulprt1,FMT = *)  &
+       ' you must define a minimum NLOGPRT = 2 '
+      CALL oasis_flush(nulprt1)
+      CALL oasis_abort_noarg()
+   ENDIF
+#endif
+
+   IF (mpi_rank_global == 0) CLOSE(nulprt1)
+
+   !------------------------
+   !--- debug file
+   !------------------------
+
+   iu=-1
+   CALL oasis_unitget(iu)
+
+       IF (OASIS_debug <= 1) THEN
+           CALL oasis_mpi_bcast(iu,mpi_comm_local,TRIM(subname)//':unit of master',0)
+           IF (mpi_rank_local == 0) THEN
+               nulprt=iu
+               WRITE(filename,'(a,i2.2)') 'debug.root.',compid
+               OPEN(nulprt,file=filename)
+               WRITE(nulprt,*) subname,' OPEN debug file for root pe, unit :',nulprt
+               call oasis_flush(nulprt)
+           ELSE
+               nulprt=iu+mpi_size_global
+               WRITE(filename2,'(a,i2.2)') 'debug_notroot.',compid
+               OPEN(nulprt,file=filename2,position='append')
+!               WRITE(nulprt,*) subname,' OPEN debug file for not root pe, unit :',nulprt
+!               CALL oasis_flush(nulprt)
+           ENDIF
+       ELSE
+           nulprt=iu
+           WRITE(filename,'(a,i2.2,a,i6.6)') 'debug.',compid,'.',mpi_rank_local
+           OPEN(nulprt,file=filename)
+           WRITE(nulprt,*) subname,' OPEN debug file, unit :',nulprt
+           CALL oasis_flush(nulprt)
+       ENDIF
+
+       IF ( (OASIS_debug == 1) .AND. (mpi_rank_local == 0)) OASIS_debug=10
+
+       IF (OASIS_debug >= 2) THEN
+           WRITE(nulprt,*) subname,' model compid ',TRIM(cdnam),compid
+           CALL oasis_flush(nulprt)
+       ENDIF
+
+   call oasis_debug_enter(subname)
+
+   !------------------------
+   !--- PIO
+   !------------------------
+#if (PIO_DEFINED)
+! tcraig, not working as of Oct 2011
+   pio_type = 'netcdf'
+   pio_stride = -99
+   pio_root = -99
+   pio_numtasks = -99
+   call oasis_ioshr_init(mpi_comm_local,pio_type,pio_stride,pio_root,pio_numtasks)
+#endif
+
+   !------------------------
+   !--- Timer Initialization
+   !------------------------
+
+   ! Allocate timer memory based on mvar
+   nt = 7*mvar+30
+   call oasis_timer_init (trim(cdnam), trim(cdnam)//'.timers',nt)
+   call oasis_timer_start('total after init')
+
+   !------------------------
+   !--- Diagnostics
+   !------------------------
+
+   if (OASIS_debug >= 2)  then
+      write(nulprt,*) subname,' compid         = ',compid
+      write(nulprt,*) subname,' compnm         = ',trim(compnm)
+      write(nulprt,*) subname,' mpi_comm_world = ',MPI_COMM_WORLD
+      write(nulprt,*) subname,' mpi_comm_global= ',mpi_comm_global
+      write(nulprt,*) subname,'     size_global= ',mpi_size_global
+      write(nulprt,*) subname,'     rank_global= ',mpi_rank_global
+      write(nulprt,*) subname,' mpi_comm_local = ',mpi_comm_local
+      write(nulprt,*) subname,'     size_local = ',mpi_size_local
+      write(nulprt,*) subname,'     rank_local = ',mpi_rank_local
+      write(nulprt,*) subname,'     root_local = ',mpi_root_local
+      write(nulprt,*) subname,' OASIS_debug    = ',OASIS_debug
+      write(nulprt,*) subname,' prism models: '
+      call oasis_flush(nulprt)
+   endif
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_init_comp
+
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_terminate(kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   integer(kind=ip_intwp_p) :: mpi_err
+   character(len=*),parameter :: subname = 'oasis_terminate'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   call oasis_timer_stop('total after init')
+   call oasis_timer_print()
+
+   call oasis_mpi_barrier(mpi_comm_global)
+   IF ( .NOT. lg_mpiflag ) THEN
+       IF (OASIS_debug >= 2)  THEN
+           WRITE (nulprt,FMT='(A)') subname//': Calling MPI_Finalize'
+           CALL oasis_flush(nulprt)
+       ENDIF
+       CALL MPI_Finalize ( mpi_err )
+   else
+       IF (OASIS_debug >= 2)  THEN
+           WRITE (nulprt,FMT='(A)') subname//': Not Calling MPI_Finalize'
+           CALL oasis_flush(nulprt)
+       ENDIF
+   ENDIF
+
+   IF (mpi_rank_local == 0)  THEN
+       WRITE(nulprt,*) subname,' SUCCESSFUL RUN'
+       CALL oasis_flush(nulprt)
+   ENDIF
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_terminate
+
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_get_localcomm(localcomm,kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(out)   :: localcomm
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_get_localcomm'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   ! from prism_data
+   localcomm = mpi_comm_local
+   IF (OASIS_debug >= 2) THEN
+       WRITE(nulprt,*) 'localcomm :',localcomm
+       CALL oasis_FLUSH(nulprt)
+   ENDIF
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_get_localcomm
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_set_couplcomm(localcomm,kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(in)   :: localcomm
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_set_couplcomm'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   !------------------------
+   !--- update mpi_comm_local from component
+   !------------------------
+
+   mpi_comm_local = localcomm
+
+   !------------------------
+   !--- and now update necessary info
+   !------------------------
+
+   mpi_size_local = -1
+   mpi_rank_local = -1
+   if (mpi_comm_local /= MPI_COMM_NULL) then
+      CALL MPI_Comm_Size(mpi_comm_local,mpi_size_local,mpi_err)
+      CALL MPI_Comm_Rank(mpi_comm_local,mpi_rank_local,mpi_err)
+      mpi_root_local = 0
+   endif
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_set_couplcomm
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_create_couplcomm(icpl,allcomm,cplcomm,kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(in)   :: icpl
+   INTEGER (kind=ip_intwp_p),intent(in)   :: allcomm
+   INTEGER (kind=ip_intwp_p),intent(out)  :: cplcomm
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   integer(kind=ip_intwp_p) :: mpi_err
+   character(len=*),parameter :: subname = 'oasis_create_couplcomm'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   !------------------------
+   !--- generate cplcomm from allcomm and icpl
+   !------------------------
+
+   CALL MPI_COMM_Split(allcomm,icpl,1,cplcomm,mpi_err)
+   IF (mpi_err /= 0) THEN
+      WRITE (nulprt,*) subname,' ERROR: MPI_Comm_Split abort ',mpi_err
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   ENDIF
+
+   !------------------------
+   !--- update mpi_comm_local from component
+   !------------------------
+
+   call oasis_set_couplcomm(cplcomm)
+
+   IF (OASIS_debug >= 2)  THEN
+       WRITE (nulprt,*) 'New local coupling comm =',cplcomm
+       CALL oasis_flush(nulprt)
+   ENDIF
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_create_couplcomm
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_get_debug(debug,kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(out)   :: debug
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_get_debug'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   debug = OASIS_debug
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_get_debug
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_set_debug(debug,kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(in)   :: debug
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_set_debug'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   OASIS_debug = debug
+   if (OASIS_debug >= 2) then
+      write(nulprt,*) subname,' set OASIS_debug to ',OASIS_debug
+      CALL oasis_flush(nulprt)
+   endif
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_set_debug
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_get_intercomm(new_comm, cdnam, kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(out) :: new_comm
+   CHARACTER(len=*),intent(in) :: cdnam
+   INTEGER (kind=ip_intwp_p),intent(out),optional :: kinfo
+
+   INTEGER (kind=ip_intwp_p)	:: n, il, ierr, tag
+   LOGICAL :: found
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_get_intercomm'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   found = .false.
+   do n = 1,prism_nmodels
+      if (trim(cdnam) == trim(prism_modnam(n))) then
+         if (found) then
+            write(nulprt,*) subname,' ERROR: found same model name twice'
+            WRITE(nulprt,*) subname,' abort by model :',compid,&
+            ' proc :',mpi_rank_local
+            CALL oasis_flush(nulprt)
+            call oasis_abort_noarg()
+         endif
+         il = n
+         found = .true.
+      endif
+   enddo
+
+   if (.not. found) then
+      write(nulprt,*) subname,' ERROR: input model name not found'
+      WRITE(nulprt,*) subname,' abort by model :',compid,&
+      ' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   IF (OASIS_debug >= 2) THEN
+       WRITE(nulprt,*) subname, 'cdnam :',cdnam,' il :',il, &
+                       'mpi_root_global(il) :',mpi_root_global(il),&
+                       'mpi_comm_local :',mpi_comm_local
+       CALL oasis_flush(nulprt)
+   ENDIF
+
+   tag=ICHAR(TRIM(compnm))+ICHAR(TRIM(cdnam))
+   CALL mpi_intercomm_create(mpi_comm_local, 0, MPI_COMM_WORLD, &
+                             mpi_root_global(il), tag, new_comm, ierr)
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_get_intercomm
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_get_intracomm(new_comm, cdnam, kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(out) :: new_comm
+   CHARACTER(len=*),intent(in) :: cdnam
+   INTEGER (kind=ip_intwp_p),intent(out),optional :: kinfo
+
+   INTEGER (kind=ip_intwp_p)	:: tmp_intercomm
+   INTEGER (kind=ip_intwp_p)	:: ierr
+!  ---------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_get_intracomm'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   call oasis_get_intercomm(tmp_intercomm, cdnam, kinfo)
+
+   CALL mpi_intercomm_merge(tmp_intercomm,.FALSE., new_comm, ierr)
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_get_intracomm
+!----------------------------------------------------------------------
+   SUBROUTINE oasis_enddef(kinfo)
+
+   IMPLICIT NONE
+
+   INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo
+!  ---------------------------------------------------------
+   integer (kind=ip_intwp_p) :: n
+   integer (kind=ip_intwp_p) :: lkinfo
+   character(len=*),parameter :: subname = 'oasis_enddef'
+!  ---------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+   lkinfo = OASIS_OK
+
+   !------------------------
+   !--- write grid info to files one model at a time
+   !------------------------
+
+   do n = 1,prism_nmodels
+      if (compid == n .and. mpi_rank_local == mpi_root_local) then
+         call oasis_write2files()
+      endif
+      call oasis_mpi_barrier(mpi_comm_global)
+   enddo
+
+   !------------------------
+   !--- MCT Initialization
+   !------------------------
+
+   call mct_world_init(prism_nmodels,mpi_comm_global,mpi_comm_local,compid)
+   IF (OASIS_debug >= 2)  THEN
+      WRITE(nulprt,*) subname, ' done mct_world_init '
+      CALL oasis_flush(nulprt)
+   ENDIF
+
+   call oasis_coupler_setup()
+   IF (OASIS_debug >= 2)  THEN
+      WRITE(nulprt,*) subname, ' done prism_coupler_setup '
+      CALL oasis_flush(nulprt)
+   ENDIF
+
+   if (mpi_comm_local /= MPI_COMM_NULL) then
+      call oasis_advance_init(lkinfo)
+      IF (OASIS_debug >= 2)  THEN
+         WRITE(nulprt,*) subname, ' done prism_advance_init '
+         CALL oasis_flush(nulprt)
+      ENDIF
+   endif
+
+   !--- Force OASIS_OK here rather than anything else ---
+
+   if (present(kinfo)) then
+      kinfo = OASIS_OK
+   endif
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_enddef
+!----------------------------------------------------------------------
+
+END MODULE mod_oasis_method
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_mpi.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_mpi.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_mpi.F90	(revision 4775)
@@ -0,0 +1,2372 @@
+MODULE mod_oasis_mpi
+
+!-------------------------------------------------------------------------------
+! PURPOSE: general layer on MPI functions
+!-------------------------------------------------------------------------------
+
+   use mod_oasis_kinds
+   USE mod_oasis_data, ONLY: compid, mpi_rank_local
+   USE mod_oasis_sys, ONLY: oasis_debug_enter, oasis_debug_exit, oasis_flush
+
+   implicit none
+   private
+
+! PUBLIC: Public interfaces
+
+   public :: oasis_mpi_chkerr
+   public :: oasis_mpi_send
+   public :: oasis_mpi_recv
+   public :: oasis_mpi_bcast
+   public :: oasis_mpi_gathScatVInit
+   public :: oasis_mpi_gatherV
+   public :: oasis_mpi_scatterV
+   public :: oasis_mpi_sum
+   public :: oasis_mpi_min
+   public :: oasis_mpi_max
+   public :: oasis_mpi_commsize
+   public :: oasis_mpi_commrank
+   public :: oasis_mpi_initialized
+   public :: oasis_mpi_wtime
+   public :: oasis_mpi_abort
+   public :: oasis_mpi_barrier
+   public :: oasis_mpi_init
+   public :: oasis_mpi_finalize
+
+   interface oasis_mpi_send ; module procedure &
+     oasis_mpi_sendi0, &
+     oasis_mpi_sendi1, &
+     oasis_mpi_sendr0, &
+     oasis_mpi_sendr1, &
+     oasis_mpi_sendr3
+   end interface
+   interface oasis_mpi_recv ; module procedure &
+     oasis_mpi_recvi0, &
+     oasis_mpi_recvi1, &
+     oasis_mpi_recvr0, &
+     oasis_mpi_recvr1, &
+     oasis_mpi_recvr3
+   end interface
+   interface oasis_mpi_bcast ; module procedure &
+     oasis_mpi_bcastc0, &
+     oasis_mpi_bcastc1, &
+     oasis_mpi_bcastl0, &
+     oasis_mpi_bcastl1, &
+     oasis_mpi_bcasti0, &
+     oasis_mpi_bcasti1, &
+     oasis_mpi_bcasti2, &
+     oasis_mpi_bcastr0, &
+     oasis_mpi_bcastr1, &
+     oasis_mpi_bcastr2, &
+     oasis_mpi_bcastr3
+   end interface
+   interface oasis_mpi_gathScatVInit ; module procedure &
+     oasis_mpi_gathScatVInitr1
+   end interface
+   interface oasis_mpi_gatherv ; module procedure &
+     oasis_mpi_gatherVr1
+   end interface
+   interface oasis_mpi_scatterv ; module procedure &
+     oasis_mpi_scatterVr1
+   end interface
+   interface oasis_mpi_sum ; module procedure &
+     oasis_mpi_sumi0, &
+     oasis_mpi_sumi1, &
+     oasis_mpi_sumb0, &
+     oasis_mpi_sumb1, &
+     oasis_mpi_sumr0, &
+     oasis_mpi_sumr1, &
+     oasis_mpi_sumr2, &
+     oasis_mpi_sumr3
+   end interface
+   interface oasis_mpi_min ; module procedure &
+     oasis_mpi_mini0, &
+     oasis_mpi_mini1, &
+     oasis_mpi_minr0, &
+     oasis_mpi_minr1
+   end interface
+   interface oasis_mpi_max ; module procedure &
+     oasis_mpi_maxi0, &
+     oasis_mpi_maxi1, &
+     oasis_mpi_maxr0, &
+     oasis_mpi_maxr1
+   end interface
+
+! mpi library include file
+#include <mpif.h>         
+
+!===============================================================================
+CONTAINS
+!===============================================================================
+
+SUBROUTINE oasis_mpi_chkerr(rcode,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: rcode  ! input MPI error code
+   character(*),         intent(in) :: string ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_chkerr'
+   character(MPI_MAX_ERROR_STRING)  :: lstring
+   integer(ip_i4_p)             :: len
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: layer on MPI error checking
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lstring = ' '
+   if (rcode /= MPI_SUCCESS) then
+     call MPI_ERROR_STRING(rcode,lstring,len,ierr)
+     write(nulprt,*) trim(subName),' model :',compid,' proc :',&
+                     mpi_rank_local,":",lstring(1:len)
+     CALL oasis_flush(nulprt)
+     call oasis_mpi_abort(string,rcode)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_chkerr
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sendi0(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec     ! send value
+   integer(ip_i4_p), intent(in) :: pid      ! pid to send to
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sendi0'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Send a single integer
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+
+   call MPI_SEND(lvec,lsize,MPI_INTEGER,pid,tag,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sendi0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sendi1(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to send to
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sendi1'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Send a vector of integers
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(lvec)
+
+   call MPI_SEND(lvec,lsize,MPI_INTEGER,pid,tag,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sendi1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sendr0(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec     ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to send to
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sendr0'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Send a real scalar
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+
+   call MPI_SEND(lvec,lsize,MPI_REAL8,pid,tag,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sendr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sendr1(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to send to
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sendr1'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Send a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(lvec)
+
+   call MPI_SEND(lvec,lsize,MPI_REAL8,pid,tag,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sendr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sendr3(array,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real   (ip_double_p), intent(in) :: array(:,:,:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid           ! pid to send to
+   integer(ip_i4_p), intent(in) :: tag           ! tag
+   integer(ip_i4_p), intent(in) :: comm          ! mpi communicator
+   character(*),optional,intent(in) :: string        ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sendr3'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Send a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(array)
+
+   call MPI_SEND(array,lsize,MPI_REAL8,pid,tag,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sendr3
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_recvi0(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(out):: lvec     ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to recv from
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_recvi0'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: status(MPI_STATUS_SIZE)  ! mpi status info
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Recv a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+
+   call MPI_RECV(lvec,lsize,MPI_INTEGER,pid,tag,comm,status,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_recvi0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_recvi1(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(out):: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to recv from
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_recvi1'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: status(MPI_STATUS_SIZE)  ! mpi status info
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Recv a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(lvec)
+
+   call MPI_RECV(lvec,lsize,MPI_INTEGER,pid,tag,comm,status,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_recvi1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_recvr0(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(out):: lvec     ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to recv from
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_recvr0'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: status(MPI_STATUS_SIZE)  ! mpi status info
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Recv a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+
+   call MPI_RECV(lvec,lsize,MPI_REAL8,pid,tag,comm,status,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_recvr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_recvr1(lvec,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(out):: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid      ! pid to recv from
+   integer(ip_i4_p), intent(in) :: tag      ! tag
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_recvr1'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: status(MPI_STATUS_SIZE)  ! mpi status info
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Recv a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(lvec)
+
+   call MPI_RECV(lvec,lsize,MPI_REAL8,pid,tag,comm,status,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_recvr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_recvr3(array,pid,tag,comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real   (ip_double_p), intent(out):: array(:,:,:)  ! in/out local values
+   integer(ip_i4_p), intent(in) :: pid           ! pid to recv from
+   integer(ip_i4_p), intent(in) :: tag           ! tag
+   integer(ip_i4_p), intent(in) :: comm          ! mpi communicator
+   character(*),optional,intent(in) :: string        ! message
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_recvr3'
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: status(MPI_STATUS_SIZE)  ! mpi status info
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Recv a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(array)
+
+   call MPI_RECV(array,lsize,MPI_REAL8,pid,tag,comm,status,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_recvr3
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcasti0(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(inout):: vec      ! vector of 1
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcasti0'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast an integer
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_INTEGER,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcasti0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastl0(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   logical, intent(inout):: vec      ! vector of 1
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastl0'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a logical
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_LOGICAL,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastl0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastc0(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   character(len=*), intent(inout)    :: vec      ! vector of 1
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastc0'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a character string
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = len(vec)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_CHARACTER,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastc0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastc1(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   character(len=*), intent(inout)    :: vec(:)   ! 1D vector
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastc1'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a character string
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(vec)*len(vec)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_CHARACTER,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastc1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastr0(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(inout):: vec      ! vector of 1
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastr0'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a real
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = 1
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_REAL8,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcasti1(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(inout):: vec(:)   ! vector 
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcasti1'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a vector of integers
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(vec)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_INTEGER,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcasti1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastl1(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   logical, intent(inout):: vec(:)      ! vector of 1
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastl1'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a logical
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(vec)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_LOGICAL,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastl1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastr1(vec,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(inout):: vec(:)   ! vector 
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_bcastr1'
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a vector of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(vec)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(vec,lsize,MPI_REAL8,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastr2(arr,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments -----
+   real(ip_double_p),    intent(inout):: arr(:,:) ! array, 2d 
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local -----
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_bcastr2'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a 2d array of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(arr)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(arr,lsize,MPI_REAL8,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastr2
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcasti2(arr,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments -----
+   integer,              intent(inout):: arr(:,:) ! array, 2d 
+   integer(ip_i4_p), intent(in)   :: comm     ! mpi communicator
+   character(*),optional,intent(in)   :: string   ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local -----
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_bcasti2'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a 2d array of integers
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(arr)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(arr,lsize,MPI_INTEGER,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcasti2
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_bcastr3(arr,comm,string,pebcast)
+
+   IMPLICIT none
+
+   !----- arguments -----
+   real(ip_double_p),    intent(inout):: arr(:,:,:) ! array, 3d 
+   integer(ip_i4_p), intent(in)   :: comm       ! mpi communicator
+   character(*),optional,intent(in)   :: string     ! message
+   integer(ip_i4_p), optional, intent(in)   :: pebcast  ! bcast pe (otherwise zero)
+
+   !----- local -----
+   integer(ip_i4_p)               :: ierr
+   integer(ip_i4_p)               :: lsize
+   integer(ip_i4_p)               :: lpebcast
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_bcastr3'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Broadcast a 3d array of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lsize = size(arr)
+   lpebcast = 0
+   if (present(pebcast)) lpebcast = pebcast
+
+   call MPI_BCAST(arr,lsize,MPI_REAL8,lpebcast,comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_bcastr3
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_gathScatvInitr1(comm, rootid, locArr, glob1DArr, globSize, &
+                                   displs, string )
+
+   IMPLICIT none
+
+   !----- arguments -----
+   integer(ip_i4_p), intent(in)   :: comm          ! mpi communicator
+   integer(ip_i4_p), intent(in)   :: rootid        ! MPI task to gather/scatter on
+   real(ip_double_p),    intent(in)   :: locArr(:)     ! Local array of distributed data
+   real(ip_double_p),    pointer      :: glob1DArr(:)  ! Global 1D array of gathered data
+   integer(ip_i4_p), pointer      :: globSize(:)   ! Size of each distributed piece
+   integer(ip_i4_p), pointer      :: displs(:)     ! Displacements for receive
+   character(*),optional,intent(in)   :: string        ! message
+
+   !----- local -----
+   integer(ip_i4_p)               :: npes          ! Number of MPI tasks
+   integer(ip_i4_p)               :: locSize       ! Size of local distributed data
+   integer(ip_i4_p), pointer      :: sendSize(:)   ! Size to send for initial gather
+   integer(ip_i4_p)               :: i             ! Index
+   integer(ip_i4_p)               :: rank          ! Rank of this MPI task
+   integer(ip_i4_p)               :: nSize         ! Maximum size to send
+   integer(ip_i4_p)               :: ierr          ! Error code
+   integer(ip_i4_p)               :: nSiz1D        ! Size of 1D global array
+   integer(ip_i4_p)               :: maxSize       ! Maximum size
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_gathScatvInitr1'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Setup arrays for a gatherv/scatterv operation
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   locSize = size(locarr)
+   call oasis_mpi_commsize( comm, npes )
+   call oasis_mpi_commrank( comm, rank )
+   allocate( globSize(npes) )
+   !
+   ! --- Gather the send global sizes from each MPI task -----------------------
+   !
+   allocate( sendSize(npes) )
+   sendSize(:) = 1
+   globSize(:) = 1
+   call MPI_GATHER( locSize, 1, MPI_INTEGER, globSize, sendSize, &
+                    MPI_INTEGER, rootid, comm, ierr )
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+   deallocate( sendSize )
+   !
+   ! --- Prepare the displacement and allocate arrays -------------------------
+   !
+   allocate( displs(npes) )
+   displs(1) = 0
+   if ( rootid /= rank )then
+      maxSize = 1
+      globSize = 1
+   else
+      maxSize = maxval(globSize)
+   end if
+   nsiz1D  = min(maxSize,globSize(1))
+   do i = 2, npes
+      nSize = min(maxSize,globSize(i-1))
+      displs(i) = displs(i-1) + nSize
+      nsiz1D = nsiz1D + min(maxSize,globSize(i))
+   end do
+   allocate( glob1DArr(nsiz1D) )
+   !----- Do some error checking for the root task arrays computed ----
+   if ( rootid == rank )then
+      if ( nsiz1D /= sum(globSize) ) &
+         call oasis_mpi_abort( subName//" : Error, size of global array not right" )
+      if ( any(displs < 0) .or. any(displs >= nsiz1D) ) &
+         call oasis_mpi_abort( subName//" : Error, displacement array not right" )
+      if ( (displs(npes)+globSize(npes)) /= nsiz1D ) &
+         call oasis_mpi_abort( subName//" : Error, displacement array values too big" )
+   end if
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_gathScatvInitr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_gathervr1(locarr, locSize, glob1DArr, globSize, displs, rootid, &
+                             comm, string )
+
+   IMPLICIT none
+
+   !----- arguments -----
+   real(ip_double_p),    intent(in)   :: locArr(:)     ! Local array
+   real(ip_double_p),    intent(inout):: glob1DArr(:)  ! Global 1D array to receive in on
+   integer(ip_i4_p), intent(in)   :: locSize       ! Number to send this PE
+   integer(ip_i4_p), intent(in)   :: globSize(:)   ! Number to receive each PE
+   integer(ip_i4_p), intent(in)   :: displs(:)     ! Displacements for receive
+   integer(ip_i4_p), intent(in)   :: rootid        ! MPI task to gather on
+   integer(ip_i4_p), intent(in)   :: comm          ! mpi communicator
+   character(*),optional,intent(in)   :: string        ! message
+
+   !----- local -----
+   integer(ip_i4_p)               :: ierr          ! Error code
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_gathervr1'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Gather a 1D array of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_GATHERV( locarr, locSize, MPI_REAL8, glob1Darr, globSize, displs, &
+                     MPI_REAL8, rootid, comm, ierr )
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_gathervr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_scattervr1(locarr, locSize, glob1Darr, globSize, displs, rootid, &
+                              comm, string )
+
+   IMPLICIT none
+
+   !----- arguments -----
+   real(ip_double_p),    intent(out)  :: locarr(:)     ! Local array
+   real(ip_double_p),    intent(in)   :: glob1Darr(:)  ! Global 1D array to send from
+   integer(ip_i4_p), intent(in)   :: locSize       ! Number to receive this PE
+   integer(ip_i4_p), intent(in)   :: globSize(:)   ! Number to send to each PE
+   integer(ip_i4_p), intent(in)   :: displs(:)     ! Displacements for send
+   integer(ip_i4_p), intent(in)   :: rootid        ! MPI task to scatter on
+   integer(ip_i4_p), intent(in)   :: comm          ! mpi communicator
+   character(*),optional,intent(in)   :: string        ! message
+
+   !----- local -----
+   integer(ip_i4_p)               :: ierr          ! Error code
+
+   !----- formats -----
+   character(*),parameter             :: subName = 'oasis_mpi_scattervr1'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Scatter a 1D array of reals
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_SCATTERV( glob1Darr, globSize, displs, MPI_REAL8, locarr, locSize, &
+                      MPI_REAL8, rootid, comm, ierr )
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_scattervr1
+
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumi0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec     ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumi0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumi0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumi1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumi1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumi1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumb0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i8_p), intent(in) :: lvec     ! in/out local values
+   integer(ip_i8_p), intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumb0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumb0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumb1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i8_p), intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i8_p), intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumb1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumb1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumr0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec     ! in/out local values
+   real(ip_double_p),    intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumr0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumr1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:)  ! in/out local values
+   real(ip_double_p),    intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumr1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumr2(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:,:)! in/out local values
+   real(ip_double_p),    intent(out):: gvec(:,:)! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumr2'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumr2
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_sumr3(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:,:,:) ! in/out local values
+   real(ip_double_p),    intent(out):: gvec(:,:,:) ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_sumr3'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds sum of a distributed vector of values, assume local sum
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_SUM
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_sumr3
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_mini0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec     ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_mini0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds min of a distributed vector of values, assume local min
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MIN
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_mini0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_mini1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_mini1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds min of a distributed vector of values, assume local min
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MIN
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_mini1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_minr0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec     ! in/out local values
+   real(ip_double_p),    intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_minr0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds min of a distributed vector of values, assume local min
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MIN
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_minr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_minr1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:)  ! in/out local values
+   real(ip_double_p),    intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_minr1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds min of a distributed vector of values, assume local min
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MIN
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_minr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_maxi0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec     ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_maxi0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds max of a distributed vector of values, assume local max
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MAX
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_maxi0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_maxi1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer(ip_i4_p), intent(in) :: lvec(:)  ! in/out local values
+   integer(ip_i4_p), intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_maxi1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds max of a distributed vector of values, assume local max
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MAX
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_INTEGER,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_maxi1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_maxr0(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec     ! in/out local values
+   real(ip_double_p),    intent(out):: gvec     ! in/out global values
+   integer(ip_i4_p), intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_maxr0'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds max of a distributed vector of values, assume local max
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MAX
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = 1
+   gsize = 1
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_maxr0
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_maxr1(lvec,gvec,comm,string,all)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_double_p),    intent(in) :: lvec(:)  ! in/out local values
+   real(ip_double_p),    intent(out):: gvec(:)  ! in/out global values
+   integer(ip_i4_p) ,    intent(in) :: comm     ! mpi communicator
+   character(*),optional,intent(in) :: string   ! message
+   logical,     optional,intent(in) :: all      ! allreduce if true
+
+   !----- local ---
+   character(*),parameter           :: subName = 'oasis_mpi_maxr1'
+   logical                          :: lall
+   character(len=256)           :: lstring
+   integer(ip_i4_p)             :: reduce_type  ! mpi reduction type
+   integer(ip_i4_p)             :: lsize
+   integer(ip_i4_p)             :: gsize
+   integer(ip_i4_p)             :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: Finds max of a distributed vector of values, assume local max
+!          already computed
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   reduce_type = MPI_MAX
+   if (present(all)) then
+     lall = all
+   else
+     lall = .false.
+   endif
+   if (present(string)) then
+     lstring = trim(subName)//":"//trim(string)
+   else
+     lstring = trim(subName)
+   endif
+
+   lsize = size(lvec)
+   gsize = size(gvec)
+
+   if (lsize /= gsize) then
+     call oasis_mpi_abort(subName//" lsize,gsize incompatable "//trim(string))
+   endif
+
+   if (lall) then
+     call MPI_ALLREDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_ALLREDUCE")
+   else
+     call MPI_REDUCE(lvec,gvec,gsize,MPI_REAL8,reduce_type,0,comm,ierr)
+     call oasis_mpi_chkerr(ierr,trim(lstring)//" MPI_REDUCE")
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_maxr1
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_commsize(comm,size,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer,intent(in)                 :: comm
+   integer,intent(out)                :: size
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_commsize'
+   integer(ip_i4_p)               :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI commsize
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_COMM_SIZE(comm,size,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_commsize
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_commrank(comm,rank,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer,intent(in)                 :: comm
+   integer,intent(out)                :: rank
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_commrank'
+   integer(ip_i4_p)                   :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI commrank
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_COMM_RANK(comm,rank,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_commrank
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_initialized(flag,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   logical,intent(out)                :: flag
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_initialized'
+   integer(ip_i4_p)                   :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI initialized
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_INITIALIZED(flag,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_initialized
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_wtime(wtime)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   real(ip_r8_p), intent(out) :: wtime  ! time
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_wtime'
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI wtime
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   wtime = MPI_WTIME()
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_wtime
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_abort(string,rcode)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   character(*),optional,intent(in)   :: string   ! message
+   integer,optional,intent(in)        :: rcode    ! optional code
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_abort'
+   integer(ip_i4_p)                   :: ierr
+   integer                            :: rc       ! return code
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI abort
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   if ( present(string) .and. present(rcode) ) then
+      write(nulprt,*) trim(subName),' model :',compid,' proc :',&
+                      mpi_rank_local,":",trim(string),rcode
+      CALL oasis_flush(nulprt)
+   endif
+   if ( present(rcode) )then
+      rc = rcode
+   else
+      rc = 1001
+   end if
+   call MPI_ABORT(MPI_COMM_WORLD,rcode,ierr)
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_abort
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_barrier(comm,string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   integer,intent(in)                 :: comm
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_barrier'
+   integer(ip_i4_p)               :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI barrier
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_BARRIER(comm,ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_barrier
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_init(string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_init'
+   integer(ip_i4_p)               :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI init
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_INIT(ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_init
+
+!===============================================================================
+!===============================================================================
+
+SUBROUTINE oasis_mpi_finalize(string)
+
+   IMPLICIT none
+
+   !----- arguments ---
+   character(*),optional,intent(in)   :: string   ! message
+
+   !----- local ---
+   character(*),parameter             :: subName = 'oasis_mpi_finalize'
+   integer(ip_i4_p)               :: ierr
+
+!-------------------------------------------------------------------------------
+! PURPOSE: MPI finalize
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+   call MPI_FINALIZE(ierr)
+   if (present(string)) then
+     call oasis_mpi_chkerr(ierr,subName//trim(string))
+   else
+     call oasis_mpi_chkerr(ierr,subName)
+   endif
+
+   call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_mpi_finalize
+
+!===============================================================================
+!===============================================================================
+
+END MODULE mod_oasis_mpi
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_namcouple.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_namcouple.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_namcouple.F90	(revision 4775)
@@ -0,0 +1,4026 @@
+MODULE mod_oasis_namcouple
+
+!     - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+  USE mod_oasis_kinds
+  USE mod_oasis_data
+  USE mod_oasis_parameters
+  USE mod_oasis_sys
+  USE mod_oasis_mpi
+  USE mod_oasis_string
+
+  IMPLICIT NONE
+
+  private
+
+  public oasis_namcouple_init
+
+! NAMCOUPLE PUBLIC DATA
+
+  INTEGER (kind=ip_intwp_p),PARAMETER :: jpeighty = 1000 ! max number of characters to be read 
+                                                         ! in each line of the file namcouple 
+                                                         ! to be changed in mod_oasis_kinds for
+                                                         ! ic_field = jpeighty
+                                                         ! if changed here
+  !
+  INTEGER(kind=ip_i4_p) ,public :: prism_nmodels   ! number of models
+  character(len=ic_lvar),public,pointer :: prism_modnam(:)  ! model names
+
+  INTEGER(kind=ip_i4_p)   ,public :: nnamcpl       ! number of namcouple inputs
+  INTEGER(kind=ip_i4_p)   ,public :: namruntim     ! namcouple runtime
+  INTEGER(kind=ip_i4_p)   ,public :: namlogprt     ! namcouple nlogprt value
+  INTEGER(kind=ip_i4_p)   ,public :: namtlogprt    ! namcouple ntlogprt value
+ 
+  character(len=jpeighty)  ,public,pointer :: namsrcfld(:)  ! list of src fields
+  character(len=jpeighty)  ,public,pointer :: namdstfld(:)  ! list of dst fields
+  character(len=ic_lvar)  ,public,pointer :: namsrcgrd(:)  ! src grid name
+  integer(kind=ip_i4_p)   ,public,pointer :: namsrc_nx(:)  ! src nx grid size
+  integer(kind=ip_i4_p)   ,public,pointer :: namsrc_ny(:)  ! src ny grid size
+  character(len=ic_lvar)  ,public,pointer :: namdstgrd(:)  ! dst grid name
+  integer(kind=ip_i4_p)   ,public,pointer :: namdst_nx(:)  ! dst nx grid size
+  integer(kind=ip_i4_p)   ,public,pointer :: namdst_ny(:)  ! dst ny grid size
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldseq(:)  ! SEQ value
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldops(:)  ! operation, ip_expout,...
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namflddti(:)  ! coupling period (secs)
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldlag(:)  ! coupling lag (secs)
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldtrn(:)  ! fields transform, ip_instant,...
+  integer(kind=ip_i4_p)   ,public,pointer :: namfldcon(:)  ! conserv fld operation
+  character(len=ic_med)   ,public,pointer :: namfldcoo(:)  ! conserv fld option (bfb, opt)
+  character(len=ic_long)  ,public,pointer :: nammapfil(:)  ! mapping file name
+  character(len=ic_med)   ,public,pointer :: nammaploc(:)  ! mapping location (src or dst pes)
+  character(len=ic_med)   ,public,pointer :: nammapopt(:)  ! mapping option (bfb, sum, or opt)
+  character(len=ic_med)   ,public,pointer :: namrstfil(:)  ! restart file name
+  character(len=ic_med)   ,public,pointer :: naminpfil(:)  ! input file name
+  logical                 ,public,pointer :: namchecki(:)  ! checkin flag
+  logical                 ,public,pointer :: namchecko(:)  ! checkout flag
+  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsmu(:)  ! src multiplier term
+  REAL (kind=ip_realwp_p) ,public,pointer :: namfldsad(:)  ! src additive term
+  REAL (kind=ip_realwp_p) ,public,pointer :: namflddmu(:)  ! dst multipler term
+  REAL (kind=ip_realwp_p) ,public,pointer :: namflddad(:)  ! dst additive term
+
+  character(len=ic_med)   ,public,pointer :: namscrmet(:)  ! scrip method (CONSERV, DISTWGT, BILINEAR, BICUBIC, GAUSWGT)
+  character(len=ic_med)   ,public,pointer :: namscrnor(:)  ! scrip conserv normalization (FRACAREA, DESTAREA, FRACNNEI)
+  character(len=ic_med)   ,public,pointer :: namscrtyp(:)  ! scrip mapping type (SCALAR, VECTOR)
+  character(len=ic_med)   ,public,pointer :: namscrord(:)  ! scrip conserve order (FIRST, SECOND)
+  character(len=ic_med)   ,public,pointer :: namscrres(:)  ! scrip search restriction (LATLON, LATITUDE)
+  REAL (kind=ip_realwp_p) ,public,pointer :: namscrvam(:)  ! scrip gauss weight distance weighting for GAUSWGT
+  integer(kind=ip_i4_p)   ,public,pointer :: namscrnbr(:)  ! scrip number of neighbors for GAUSWGT and DISTWGT
+  integer(kind=ip_i4_p)   ,public,pointer :: namscrbin(:)  ! script number of search bins
+
+  !--- derived ---
+  INTEGER(kind=ip_i4_p)   ,public,pointer :: namfldsort(:) ! sorted namcpl list based on seq
+
+!----------------------------------------------------------------
+!   LOCAL ONLY BELOW HERE
+!----------------------------------------------------------------
+
+  integer(kind=ip_i4_p) :: nulin     ! namcouple IO unit number
+  character(len=*),parameter :: cl_namcouple = 'namcouple'
+
+! --- alloc_src
+  INTEGER (kind=ip_intwp_p) :: il_err
+! --- mod_unitncdf
+  LOGICAL :: lncdfgrd
+  LOGICAL :: lncdfrst
+! --- mod_label
+  CHARACTER(len=5), PARAMETER :: cgrdnam = 'grids'  
+  CHARACTER(len=5), PARAMETER :: cmsknam = 'masks' 
+  CHARACTER(len=5), PARAMETER :: csurnam = 'areas' 
+  CHARACTER(len=5), PARAMETER :: crednam = 'maskr'
+  CHARACTER(len=4), PARAMETER :: cglonsuf = '.lon'
+  CHARACTER(len=4), PARAMETER :: cglatsuf = '.lat'
+  CHARACTER(len=4), PARAMETER :: crnlonsuf = '.clo'
+  CHARACTER(len=4), PARAMETER :: crnlatsuf = '.cla'
+  CHARACTER(len=4), PARAMETER :: cmsksuf = '.msk'
+  CHARACTER(len=4), PARAMETER :: csursuf = '.srf'
+  CHARACTER(len=4), PARAMETER :: cangsuf = '.ang'
+! --- mod_rainbow
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: lmapp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: lsubg
+! --- mod_coast
+  INTEGER (kind=ip_intwp_p) :: nfcoast
+  LOGICAL :: lcoast
+! --- mod_timestep
+  INTEGER (kind=ip_intwp_p) :: ntime
+  INTEGER (kind=ip_intwp_p) :: niter
+  INTEGER (kind=ip_intwp_p) :: nitfn
+  INTEGER (kind=ip_intwp_p) :: nstep
+! --- mod_parameter
+  INTEGER (kind=ip_intwp_p) :: ig_nmodel   ! number of models (not including oasis)
+  INTEGER (kind=ip_intwp_p) :: ig_nfield   ! number of oasis coupled fields
+  INTEGER (kind=ip_intwp_p) :: ig_direct_nfield   ! number of direct coupled fields
+  INTEGER (kind=ip_intwp_p) :: ig_total_nfield    ! number of total fields
+  LOGICAL :: lg_oasis_field
+  INTEGER (kind=ip_intwp_p) :: ig_maxcomb
+  INTEGER (kind=ip_intwp_p) :: ig_maxnoa
+  INTEGER (kind=ip_intwp_p) :: ig_maxnfg
+! --- mod_printing
+  INTEGER(kind=ip_intwp_p) :: nlogprt
+!---- Time statistics level printing
+  INTEGER(kind=ip_intwp_p) :: ntlogprt
+! --- mod_experiment
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: iga_unitmod
+  CHARACTER(len=6) , DIMENSION(:), ALLOCATABLE :: cmodnam
+! --- mod_string
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: numlab
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_numlab
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nfexch
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_ntrans
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_ntrans
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonbf
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlatbf
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlonaf
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlataf
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nseqn
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_nseqn
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_freq
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_lag
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: nlagn 
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_invert
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_reverse
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_number_field
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_no_rstfile
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_total_state
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_local_trans
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbrbf
+  INTEGER (kind=ip_intwp_p),DIMENSION(:),ALLOCATABLE :: ig_grid_nbraf
+  INTEGER (kind=ip_intwp_p)                          :: ig_nbr_rstfile
+  INTEGER (kind=ip_intwp_p)                          :: ig_total_frqmin
+  LOGICAL                  ,DIMENSION(:),ALLOCATABLE :: lg_state
+  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cnaminp
+  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cnamout
+  CHARACTER(len=8)         ,DIMENSION(:,:),ALLOCATABLE :: canal
+  CHARACTER(len=8)                                   :: cg_c
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cg_name_rstfile
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cg_restart_file
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficinp
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficout
+  CHARACTER(len=32)        ,DIMENSION(:),ALLOCATABLE :: cg_input_file
+  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cg_input_field
+  CHARACTER(len=jpeighty)   ,DIMENSION(:),ALLOCATABLE :: cg_output_field
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficbf
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cficaf
+  CHARACTER(len=8)         ,DIMENSION(:),ALLOCATABLE :: cstate
+  CHARACTER(len=4)         ,DIMENSION(:),ALLOCATABLE :: cga_locatorbf
+  CHARACTER(len=4)         ,DIMENSION(:),ALLOCATABLE :: cga_locatoraf
+! --- mod_analysis
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighbor
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ntronca
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: ncofld
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: neighborg
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbofld
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nbnfld
+  INTEGER (kind=ip_intwp_p), DIMENSION(:,:), ALLOCATABLE :: nludat
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlufil
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlumap 
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapfl
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nmapvoi
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nlusub
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubfl
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nsubvoi
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nluext
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nextfl
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nosper
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: notper
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE ::  nbins
+  INTEGER (kind=ip_intwp_p) :: nlucor
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE ::  nscripvoi
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskval
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: amskvalnew
+  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: acocoef
+  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abocoef
+  REAL (kind=ip_realwp_p), DIMENSION(:,:), ALLOCATABLE :: abncoef
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcoef
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobo
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: afldcobn
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordbf
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordbf
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cxordaf
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cyordaf
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cextmet
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cintmet
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdtyp
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtyp
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilfic
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfilmet 
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconmet
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cconopt
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldcoa
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldfin
+  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofld
+  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbofld
+  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: cbnfld
+  CHARACTER(len=8), DIMENSION(:,:),ALLOCATABLE :: ccofic
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cdqdt
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdmap
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmskrd
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdsub
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctypsub
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cgrdext
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: csper
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: ctper
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmap_method
+  CHARACTER(len=ic_long), DIMENSION(:),ALLOCATABLE :: cmap_file
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmaptyp
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cmapopt
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: corder
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cnorm_opt
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: cfldtype
+  CHARACTER(len=8), DIMENSION(:),ALLOCATABLE :: crsttype
+  CHARACTER(len=8) :: cfldcor
+  LOGICAL, DIMENSION(:),ALLOCATABLE :: lsurf
+! --- mod_anais
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismfl
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgfl
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naismvoi
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: naisgvoi
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtm
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtg
+  REAL (kind=ip_realwp_p), DIMENSION(:), ALLOCATABLE :: varmul
+  LOGICAL, DIMENSION(:), ALLOCATABLE :: linit
+! --- mod extrapol
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtn
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnfl 
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: niwtng
+  INTEGER (kind=ip_intwp_p), DIMENSION(:), ALLOCATABLE :: nninnflg
+  LOGICAL, DIMENSION(:), ALLOCATABLE :: lextra
+  LOGICAL, DIMENSION(:), ALLOCATABLE :: lweight
+!---------------------
+!------------------------------------------------------------
+CONTAINS
+!------------------------------------------------------------
+  SUBROUTINE oasis_namcouple_init()
+
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------
+  integer(kind=ip_i4_p) :: n, nv, n1, loc
+  integer(kind=ip_i4_p) :: ja, jf, jc
+  integer(kind=ip_i4_p) :: il_iost
+  integer(kind=ip_i4_p) :: maxunit
+  character(len=*),parameter :: subname='oasis_namcouple_init'
+  !-----------------------------------------------------------
+
+  CALL oasis_unitget(nulin)
+  OPEN (UNIT = nulin,FILE =cl_namcouple,STATUS='OLD', &
+     FORM ='FORMATTED', IOSTAT = il_iost)
+
+  IF (mpi_rank_global == 0) THEN
+      IF (il_iost .NE. 0) THEN
+          WRITE(nulprt1,*) subname,' ERROR opening namcouple file ',TRIM(cl_namcouple),&
+                           ' with unit number ', nulin
+          WRITE (nulprt,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt,'(a)') ' error = ERROR opening namcouple file'
+          CALL oasis_flush(nulprt1)
+          CALL oasis_abort_noarg()
+      ELSE
+          WRITE(nulprt1,*) subname,' open namcouple file ',TRIM(cl_namcouple),' with unit number ', &
+                           nulin
+      ENDIF
+  ENDIF
+
+  call inipar_alloc()
+  call alloc()
+  call inipar()
+  !
+  ! Close namcouple unit
+  close(nulin)
+  
+  CALL oasis_unitfree(nulin)
+
+  IF (mpi_rank_global == 0) THEN
+      WRITE(nulprt1,*) subname,' allocating ig_nmodel+1',ig_nmodel+1
+      WRITE(nulprt1,*) subname,' allocating ig_total_nfield',ig_total_nfield
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+  allocate(prism_modnam(ig_nmodel+1), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "prism_modnam" allocation of experiment module',il_err,1)
+
+  allocate(namsrcfld(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namsrcfld" allocation of experiment module',il_err,1)
+
+  allocate(namdstfld(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namdstfld" allocation of experiment module',il_err,1)
+
+  allocate(namsrcgrd(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namsrcgrd" allocation of experiment module',il_err,1)
+
+  allocate(namsrc_nx(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namsrc_nx" allocation of experiment module',il_err,1)
+
+  allocate(namsrc_ny(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namsrc_ny" allocation of experiment module',il_err,1)
+
+  allocate(namdstgrd(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namdstgrd" allocation of experiment module',il_err,1)
+
+  allocate(namdst_nx(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namdst_nx" allocation of experiment module',il_err,1)
+
+  allocate(namdst_ny(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namdst_ny" allocation of experiment module',il_err,1)
+
+  allocate(namfldseq(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldseq" allocation of experiment module',il_err,1)
+
+  allocate(namfldops(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldops" allocation of experiment module',il_err,1)
+
+  allocate(namfldtrn(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldtrn" allocation of experiment module',il_err,1)
+
+  allocate(namfldcon(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldcon" allocation of experiment module',il_err,1)
+
+  allocate(namfldcoo(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldcoo" allocation of experiment module',il_err,1)
+
+  allocate(namflddti(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namflddti" allocation of experiment module',il_err,1)
+
+  allocate(namfldlag(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldlag" allocation of experiment module',il_err,1)
+
+  allocate(nammapfil(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "nammapfil" allocation of experiment module',il_err,1)
+
+  allocate(nammaploc(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "nammaploc" allocation of experiment module',il_err,1)
+
+  allocate(nammapopt(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "nammapopt" allocation of experiment module',il_err,1)
+
+  allocate(namrstfil(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namrstfil" allocation of experiment module',il_err,1)
+
+  allocate(naminpfil(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "naminpfil" allocation of experiment module',il_err,1)
+
+  allocate(namfldsort(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldsort" allocation of experiment module',il_err,1)
+
+  allocate(namchecki(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namchecki" allocation of experiment module',il_err,1)
+
+  allocate(namchecko(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namchecko" allocation of experiment module',il_err,1)
+
+  allocate(namfldsmu(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldsmu" allocation of experiment module',il_err,1)
+
+  allocate(namfldsad(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namfldsad" allocation of experiment module',il_err,1)
+
+  allocate(namflddmu(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namflddmu" allocation of experiment module',il_err,1)
+
+  allocate(namflddad(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namflddad" allocation of experiment module',il_err,1)
+
+  allocate(namscrmet(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrmet" allocation of experiment module',il_err,1)
+
+  allocate(namscrnor(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrnor" allocation of experiment module',il_err,1)
+
+  allocate(namscrtyp(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrtyp" allocation of experiment module',il_err,1)
+
+  allocate(namscrord(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrord" allocation of experiment module',il_err,1)
+
+  allocate(namscrres(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrres" allocation of experiment module',il_err,1)
+
+  allocate(namscrvam(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrvam" allocation of experiment module',il_err,1)
+
+  allocate(namscrnbr(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrnbr" allocation of experiment module',il_err,1)
+
+  allocate(namscrbin(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout('Error in "namscrbin" allocation of experiment module',il_err,1)
+
+  prism_modnam(:) = trim(cspval)
+  namsrcfld(:) = trim(cspval)
+  namdstfld(:) = trim(cspval)
+  namsrcgrd(:) = trim(cspval)
+  namsrc_nx(:) = 0
+  namsrc_ny(:) = 0
+  namdstgrd(:) = trim(cspval)
+  namdst_nx(:) = 0
+  namdst_ny(:) = 0
+  namfldseq(:) = -1
+  namfldops(:) = -1
+  namfldtrn(:) = ip_instant
+  namfldcon(:) = ip_cnone
+  namfldcoo(:) = "bfb"
+  namflddti(:) = -1
+  namfldlag(:) = 0
+  nammapfil(:) = "idmap"
+  nammaploc(:) = "src"
+  nammapopt(:) = "bfb"
+  namrstfil(:) = trim(cspval)
+  naminpfil(:) = trim(cspval)
+  namchecki(:) = .false.
+  namchecko(:) = .false.
+  namfldsmu(:) = 1.0_ip_realwp_p
+  namfldsad(:) = 0.0_ip_realwp_p
+  namflddmu(:) = 1.0_ip_realwp_p
+  namflddad(:) = 0.0_ip_realwp_p
+
+  namscrmet(:) = trim(cspval)
+  namscrnor(:) = trim(cspval)
+  namscrtyp(:) = trim(cspval)
+  namscrord(:) = trim(cspval)
+  namscrres(:) = trim(cspval)
+  namscrvam(:) = 1.0_ip_realwp_p
+  namscrnbr(:) = -1
+  namscrbin(:) = -1
+
+  maxunit = maxval(iga_unitmod)
+  IF (mpi_rank_global == 0) THEN
+      WRITE(nulprt1,*) subname,' maximum unit number = ',maxunit
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+  call oasis_unitsetmin(maxunit)
+
+  prism_nmodels = ig_nmodel
+
+  do n = 1,ig_nmodel
+    prism_modnam(n) = trim(cmodnam(n))
+  enddo
+
+  IF (mpi_rank_global == 0) THEN
+      WRITE(nulprt1,*) subname,' total number of models = ',prism_nmodels
+      DO n = 1,prism_nmodels
+        WRITE(nulprt1,*) subname,n,TRIM(prism_modnam(n))
+      ENDDO
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+  nnamcpl = ig_total_nfield
+  namruntim = ntime
+  namlogprt = nlogprt
+  namtlogprt = ntlogprt
+  do jf = 1,ig_total_nfield
+    namsrcfld(jf) = cg_input_field(jf)
+    namdstfld(jf) = cg_output_field(jf)
+    namfldseq(jf) = ig_total_nseqn(jf)
+    namfldops(jf) = ig_total_state(jf)
+    if (namfldops(jf) == ip_auxilary) then
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) subname,jf,'ERROR: AUXILARY NOT SUPPORTED'
+            WRITE (nulprt1,'(a)') ' error = STOP in oasis_namcouple_init'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        call oasis_abort_noarg()
+    endif
+    if (namfldops(jf) == ip_ignored) then
+        namfldops(jf) = ip_exported
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) subname,jf,'WARNING: IGNORED converted to EXPORTED'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+    endif
+    if (namfldops(jf) == ip_ignout) then
+        namfldops(jf) = ip_expout
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) subname,jf,'WARNING: IGNOUT converted to EXPOUT'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+    endif
+    namflddti(jf) = ig_freq(jf)
+    namfldlag(jf) = ig_lag(jf)
+    namfldtrn(jf) = ig_local_trans(jf)
+    namrstfil(jf) = trim(cg_restart_file(jf))
+    naminpfil(jf) = trim(cg_input_file(jf))
+    if (ig_number_field(jf) > 0) then
+        namsrcgrd(jf) = trim(cficbf(ig_number_field(jf)))
+        namsrc_nx(jf) = nlonbf(ig_number_field(jf))
+        namsrc_ny(jf) = nlatbf(ig_number_field(jf))
+        namdstgrd(jf) = trim(cficaf(ig_number_field(jf)))
+        namdst_nx(jf) = nlonaf(ig_number_field(jf))
+        namdst_ny(jf) = nlataf(ig_number_field(jf))
+        do ja = 1, ig_ntrans(ig_number_field(jf))
+
+          if (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') then
+              namscrmet(jf) = trim(cmap_method(ig_number_field(jf)))
+              namscrnor(jf) = trim(cnorm_opt  (ig_number_field(jf)))
+              namscrtyp(jf) = trim(cfldtype   (ig_number_field(jf)))
+              namscrord(jf) = trim(corder     (ig_number_field(jf)))
+              namscrres(jf) = trim(crsttype   (ig_number_field(jf)))
+              namscrvam(jf) =      varmul     (ig_number_field(jf))
+              namscrnbr(jf) =      nscripvoi  (ig_number_field(jf))
+              namscrbin(jf) =      nbins      (ig_number_field(jf))
+              IF (TRIM(namscrtyp(jf)) /= 'SCALAR') THEN
+                  IF (mpi_rank_global == 0) THEN
+                      WRITE(nulprt1,*) subname,jf,'WARNING: SCRIPR weights generation &
+                      & supported only for SCALAR mapping, not '//TRIM(namscrtyp(jf))
+                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                      WRITE (nulprt1,'(a)') ' error = ERROR in SCRIPR CFTYP option'
+                      CALL oasis_flush(nulprt1)
+                  ENDIF
+                  CALL oasis_abort_noarg()
+              ENDIF
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') then
+              nammapfil(jf) = trim(cmap_file(ig_number_field(jf)))
+              nammaploc(jf) = trim(cmaptyp(ig_number_field(jf)))
+              nammapopt(jf) = trim(cmapopt(ig_number_field(jf)))
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') then
+              namfldcon(jf) = ip_cnone
+              namfldcoo(jf) = trim(cconopt(ig_number_field(jf)))
+              if (cconmet(ig_number_field(jf)) .EQ. 'GLOBAL') namfldcon(jf) = ip_cglobal
+              if (cconmet(ig_number_field(jf)) .EQ. 'GLBPOS') namfldcon(jf) = ip_cglbpos
+              if (cconmet(ig_number_field(jf)) .EQ. 'BASBAL') namfldcon(jf) = ip_cbasbal
+              if (cconmet(ig_number_field(jf)) .EQ. 'BASPOS') namfldcon(jf) = ip_cbaspos
+              if (namfldcon(jf) .EQ. ip_cnone) then
+                  IF (mpi_rank_global == 0) THEN
+                      WRITE(nulprt1,*) subname,jf,'WARNING: CONSERV option not supported: '//&
+                                       &TRIM(cconmet(ig_number_field(jf)))
+                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                      WRITE (nulprt1,'(a)') ' error = ERROR in CONSERV option'
+                      CALL oasis_flush(nulprt1)
+                  ENDIF
+                  CALL oasis_abort_noarg()
+              endif
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN' ) then
+              namchecki(jf) = .true.
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') then
+              namchecko(jf) = .true.
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') then
+              namfldsmu(jf) = afldcobo(ig_number_field(jf))
+              do jc = 1, nbofld(ig_number_field(jf))
+                if (trim(cbofld(jc,ig_number_field(jf))) == 'CONSTANT') then
+                    namfldsad(jf) = abocoef(jc,ig_number_field(jf))
+                else
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE(nulprt1,*) subname,jf,'ERROR: BLASOLD only supports CONSTANT: '//&
+                                         &TRIM(cbofld(jc,ig_number_field(jf)))
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = ERROR in BLASOLD option'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    call oasis_abort_noarg()
+                endif
+              enddo
+
+          elseif (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') then
+              namflddmu(jf) = afldcobn(ig_number_field(jf))
+              do jc = 1, nbnfld(ig_number_field(jf))
+                if (trim(cbnfld(jc,ig_number_field(jf))) == 'CONSTANT') then
+                    namflddad(jf) = abncoef(jc,ig_number_field(jf))
+                else
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE(nulprt1,*) subname,jf,'ERROR: BLASNEW only supports CONSTANTS: '//&
+                                         &TRIM(cbofld(jc,ig_number_field(jf)))
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = ERROR in BLASNEW option'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    call oasis_abort_noarg()
+                endif
+              enddo
+
+          endif  ! canal
+        enddo  ! ig_ntrans
+    endif   ! ig_number_field
+  enddo   ! ig_total_nfield
+
+  IF (mpi_rank_global == 0) THEN
+      WRITE(nulprt1,*) ' '
+      WRITE(nulprt1,*) subname,'namlogprt ',namlogprt
+      WRITE(nulprt1,*) ' '
+      DO n = 1,nnamcpl
+        WRITE(nulprt1,*) subname,n,'namsrcfld ',TRIM(namsrcfld(n))
+        WRITE(nulprt1,*) subname,n,'namdstfld ',TRIM(namdstfld(n))
+        WRITE(nulprt1,*) subname,n,'namsrcgrd ',TRIM(namsrcgrd(n))
+        WRITE(nulprt1,*) subname,n,'namsrc_nx ',namsrc_nx(n)
+        WRITE(nulprt1,*) subname,n,'namsrc_ny ',namsrc_ny(n)
+        WRITE(nulprt1,*) subname,n,'namdstgrd ',TRIM(namdstgrd(n))
+        WRITE(nulprt1,*) subname,n,'namdst_nx ',namdst_nx(n)
+        WRITE(nulprt1,*) subname,n,'namdst_ny ',namdst_ny(n)
+        WRITE(nulprt1,*) subname,n,'namfldseq ',namfldseq(n)
+        WRITE(nulprt1,*) subname,n,'namfldops ',namfldops(n)
+        WRITE(nulprt1,*) subname,n,'namfldtrn ',namfldtrn(n)
+        WRITE(nulprt1,*) subname,n,'namfldcon ',namfldcon(n)
+        WRITE(nulprt1,*) subname,n,'namfldcoo ',TRIM(namfldcoo(n))
+        WRITE(nulprt1,*) subname,n,'namflddti ',namflddti(n)
+        WRITE(nulprt1,*) subname,n,'namfldlag ',namfldlag(n)
+        WRITE(nulprt1,*) subname,n,'nammapfil ',TRIM(nammapfil(n))
+        WRITE(nulprt1,*) subname,n,'nammaploc ',TRIM(nammaploc(n))
+        WRITE(nulprt1,*) subname,n,'nammapopt ',TRIM(nammapopt(n))
+        WRITE(nulprt1,*) subname,n,'namrstfil ',TRIM(namrstfil(n))
+        WRITE(nulprt1,*) subname,n,'naminpfil ',TRIM(naminpfil(n))
+        WRITE(nulprt1,*) subname,n,'namchecki ',namchecki(n)
+        WRITE(nulprt1,*) subname,n,'namchecko ',namchecko(n)
+        WRITE(nulprt1,*) subname,n,'namfldsmu ',namfldsmu(n)
+        WRITE(nulprt1,*) subname,n,'namfldsad ',namfldsad(n)
+        WRITE(nulprt1,*) subname,n,'namflddmu ',namflddmu(n)
+        WRITE(nulprt1,*) subname,n,'namflddad ',namflddad(n)
+        WRITE(nulprt1,*) subname,n,'namscrmet ',TRIM(namscrmet(n))
+        WRITE(nulprt1,*) subname,n,'namscrnor ',TRIM(namscrnor(n))
+        WRITE(nulprt1,*) subname,n,'namscrtyp ',TRIM(namscrtyp(n))
+        WRITE(nulprt1,*) subname,n,'namscrord ',TRIM(namscrord(n))
+        WRITE(nulprt1,*) subname,n,'namscrres ',TRIM(namscrres(n))
+        WRITE(nulprt1,*) subname,n,'namscrvam ',namscrvam(n)
+        WRITE(nulprt1,*) subname,n,'namscrnbr ',namscrnbr(n)
+        WRITE(nulprt1,*) subname,n,'namscrbin ',namscrbin(n)
+        WRITE(nulprt1,*) ' '
+        CALL oasis_flush(nulprt1)
+      ENDDO
+  ENDIF
+
+  !--- compute seq sort ---
+  namfldsort(:) = -1
+  do nv = 1,nnamcpl
+    loc = nv    ! default at end
+    n1 = 1
+    do while (loc == nv .and. n1 < nv)
+      if (namfldseq(nv) < namfldseq(namfldsort(n1))) loc = n1
+      n1 = n1 + 1
+    enddo
+    ! nv goes into loc location, shift then set
+    do n1 = nv,loc+1,-1
+      namfldsort(n1) = namfldsort(n1-1)
+    enddo
+    namfldsort(loc) = nv
+  enddo
+
+  IF (mpi_rank_global == 0) THEN
+      DO nv = 1,nnamcpl
+        n1 = namfldsort(nv)
+        WRITE(nulprt1,*) subname,' sort ',nv,n1,namfldseq(n1)
+        CALL oasis_flush(nulprt1)
+      ENDDO
+  ENDIF
+
+
+  !--- check they are sorted ---
+  do n = 2,nnamcpl
+    if (namfldseq(namfldsort(n)) < namfldseq(namfldsort(n-1))) then
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) subname,' ERROR in seq sort'
+            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+            WRITE (nulprt1,'(a)') ' error = ERROR in seq sort'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        call oasis_abort_noarg()
+    endif
+  enddo
+
+  call dealloc()
+
+  !  call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_namcouple_init
+
+!===============================================================================
+
+SUBROUTINE inipar_alloc()
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL 0 *
+!               * -------------     ------- *
+!               *****************************
+
+!**** *inipar_alloc*  - Get main run parameters to allocate arrays 
+
+!     Purpose:
+!     -------
+!     Reads out run parameters.
+
+!**   Interface:
+!     ---------
+!       *CALL*  *inipar_alloc*
+
+!     Input:
+!     -----
+!     None
+
+!     Output:
+!     ------
+!     None
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+  IMPLICIT NONE
+
+  !* ---------------------------- Local declarations --------------------
+  
+  CHARACTER*1000 clline, clline_aux, clvari
+  CHARACTER*9 clword, clfield, clstring, clmod, clchan
+  CHARACTER*3 clind
+  CHARACTER*2 cldeb
+  CHARACTER*1 clequa
+  CHARACTER*8 clwork
+  CHARACTER*8 clstrg
+  CHARACTER*7 cl_bsend
+
+  CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: cl_aux
+  INTEGER (kind=ip_intwp_p) il_varid, il_len, il_err, il_maxanal 
+  INTEGER (kind=ip_intwp_p) nlonbf_notnc, nlatbf_notnc,  &
+     nlonaf_notnc, nlataf_notnc
+  INTEGER (kind=ip_intwp_p) iind, il_redu, ib, il_aux, il_auxbf, &
+     il_auxaf, istatus, il_id
+  integer (kind=ip_intwp_p) :: ja,jz,jm,jf,ilen
+  integer (kind=ip_intwp_p) :: ig_clim_maxport
+  logical :: lg_bsend,endflag
+  character(len=*),parameter :: subname='mod_oasis_namcouple:inipar_alloc'
+
+  !* ---------------------------- Poema verses --------------------------
+
+  !  call oasis_debug_enter(subname)
+
+  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+  !*    1. Get basic info for the simulation 
+  !        ---------------------------------
+
+  IF (mpi_rank_global == 0) THEN
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)'  ROUTINE inipar_alloc - Level 0'
+      WRITE (UNIT = nulprt1,FMT = *)'  ********************   *******'
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)'  Initialization of run parameters'
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)'  Reading input file namcouple'
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+  !* Initialization
+  ig_direct_nfield = 0
+  ig_nfield = 0
+  lg_oasis_field = .true.
+  !* Initialize character keywords to locate appropriate input
+
+  clfield  = ' $NFIELDS'
+  clchan   = ' $CHANNEL'
+  clstring = ' $STRINGS'
+  clmod    = ' $NBMODEL'
+
+  !* Get number of models involved in this simulation
+
+  REWIND nulin
+100 CONTINUE
+  READ (UNIT = nulin,FMT = 1001,END = 110) clword
+  IF (clword .NE. clmod) GO TO 100
+  READ (UNIT = nulin,FMT = 1002) clline
+  CALL parse (clline, clvari, 1, jpeighty, ilen)
+  IF (ilen .LE. 0 .or.ilen .GT. 1 ) THEN
+      GOTO 110
+  ELSE
+      READ (clvari,FMT = 1003) ig_nmodel
+  ENDIF
+
+  !* Print out the number of models
+
+  CALL prtout &
+     ('The number of models for this run is nmodel =', ig_nmodel, &
+     1)
+  !tcx inline
+  !      CALL alloc_experiment
+
+  ALLOCATE (cmodnam(ig_nmodel), stat=il_err)
+  IF (il_err.NE.0) CALL prtout & 
+     ('Error in "cmodnam"allocation of experiment module',il_err,1)
+  cmodnam(:)=' '
+  ALLOCATE (iga_unitmod(ig_nmodel), stat=il_err)
+  IF (il_err.NE.0) CALL prtout & 
+     ('Error in iga_unitmod allocation of experiment module',il_err,1)
+  iga_unitmod(:)=0
+
+  ! --> Get the message passing technique we are using
+
+  REWIND nulin
+120 CONTINUE
+  READ (UNIT = nulin,FMT = 1001,END = 130) clword
+  IF (clword .NE. clchan) GO TO 120
+  IF (mpi_rank_global == 0) THEN
+      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+      WRITE (UNIT = nulprt1,FMT = *) 'Information below $CHANNEL'
+      WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
+      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+130 CONTINUE
+
+  !* Formats
+
+1001 FORMAT(A9)
+1002 FORMAT(A1000)
+1003 FORMAT(I1)
+
+
+  !*    2. Get field information
+  !        ---------------------
+  
+  !* Read total number of fields exchanged by this OASIS process
+  
+  REWIND nulin
+200 CONTINUE
+  READ (UNIT = nulin,FMT = 2001,END = 210) clword
+  IF (clword .NE. clfield) GO TO 200
+  READ (UNIT = nulin,FMT = 2002) clline
+  CALL parse(clline, clvari, 1, jpeighty, ilen)
+  IF (ilen .LE. 0) THEN
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' Nothing on input for $NFIELDS '
+          WRITE (UNIT = nulprt1,FMT = *) ' Default value will be used '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          CALL oasis_flush(nulprt1)
+      ENDIF
+  ELSE
+      READ (clvari,FMT = 2003) ig_total_nfield
+  ENDIF
+
+  !* Print out the total number of fields exchanged by this OASIS process
+
+  CALL prtout &
+     ('The number of exchanged fields is nfield =',  &
+     ig_total_nfield, 1)
+
+  !* Alloc field number array 
+
+  ALLOCATE (ig_number_field(ig_total_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: ig_number_field allocation of inipar_alloc',il_err,1)
+  ig_number_field(:)=0
+
+  !* Alloc field status array (logical indicating if the field goes through 
+  !* Oasis or not)
+
+  ALLOCATE (lg_state(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: lg_state allocation of inipar_alloc',il_err,1)
+  lg_state(:)=.false.
+
+  !* Alloc status of all the fields
+
+  ALLOCATE (ig_total_state(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: ig_total_state allocation of inipar_alloc',il_err,1)
+  ig_total_state(:)=0
+
+  !* Alloc input field name array 
+
+  ALLOCATE (cg_output_field(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: cg_output_field allocation of inipar_alloc',il_err,1)
+  cg_output_field(:)=' ' 
+
+  !* Alloc number of analyses array 
+
+  ALLOCATE (ig_total_ntrans(ig_total_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: ig_total_ntrans"allocation of inipar_alloc',il_err,1)
+  ig_total_ntrans (:) = 0
+
+  !* Alloc array of restart file names, input and output file names
+
+  ALLOCATE (cg_restart_file(ig_total_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: cg_restart_FILE allocation of inipar_alloc',il_err,1)
+  cg_restart_file(:)=' '
+  ALLOCATE (cg_input_file(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error in "cg_input_file"allocation of inipar_alloc',il_err,1)
+  cg_input_file(:)=' '
+
+  !* Alloc array of source and target locator prefix
+
+  ALLOCATE (cga_locatorbf(ig_total_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: cga_locatorbf allocation of inipar_alloc',il_err,1)
+  cga_locatorbf(:)=' '
+
+  ALLOCATE (cga_locatoraf(ig_total_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout  &
+     ('Error: cga_locatoraf allocation of inipar_alloc',il_err,1)
+  cga_locatoraf(:)=' '  
+
+  !* Get information for all fields
+
+  REWIND nulin
+220 CONTINUE
+  READ (UNIT = nulin,FMT = 2001,END = 230) clword
+  IF (clword .NE. clstring) GO TO 220
+
+  !* Loop on total number of fields
+  
+  DO 240 jf = 1, ig_total_nfield
+
+    !* First line
+
+    READ (UNIT = nulin,FMT = 2002, END=241) clline
+    CALL parse(clline, clvari, 1, jpeighty, ilen)
+    IF (TRIM(clvari) .EQ. " ") GOTO 232
+    IF (trim(clvari) .eq. "$END") goto 241
+    !* Get output field symbolic name
+    CALL parse(clline, clvari, 2, jpeighty, ilen)
+    cg_output_field(jf) = clvari
+    !* Get total number of analysis
+    CALL parse(clline, clvari, 5, jpeighty, ilen)
+    READ (clvari,FMT = 2003) ig_total_ntrans(jf)
+    !* Get field STATUS for OUTPUT fields
+    CALL parse(clline, clvari, 6, jpeighty, ilen)
+    IF (clvari(1:6) .EQ. 'OUTPUT') THEN
+        ig_direct_nfield = ig_direct_nfield + 1
+        lg_state(jf) = .false.
+        ig_total_state(jf) = ip_output
+    ELSE
+        !* Get field status (direct or through oasis) and the number  
+        !* of direct and indirect fields if not PIPE nor NONE
+        CALL parse(clline, clvari, 7, jpeighty, ilen)
+        IF (clvari(1:8).eq.'EXPORTED') THEN
+            ig_nfield = ig_nfield + 1
+            lg_state(jf) = .true.
+            ig_number_field(jf) = ig_nfield
+            ig_total_state(jf) = ip_exported
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get restart file name               
+            cg_restart_file(jf) = clvari
+            !* Get restart file name
+        ELSEIF (clvari(1:6) .eq. 'OUTPUT' ) THEN
+            ig_direct_nfield = ig_direct_nfield + 1
+            lg_state(jf) = .false.
+            ig_total_state(jf) = ip_output
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            cg_restart_file(jf) = clvari
+        ELSEIF (clvari(1:7) .eq. 'IGNORED' ) THEN
+            ig_direct_nfield = ig_direct_nfield + 1
+            lg_state(jf) = .false.
+            ig_total_state(jf) = ip_ignored
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get restart file name
+            cg_restart_file(jf) = clvari
+        ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
+            ig_nfield = ig_nfield + 1
+            lg_state(jf) = .true.
+            ig_number_field(jf) = ig_nfield
+            ig_total_state(jf) = ip_expout
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get restart file name               
+            cg_restart_file(jf) = clvari
+        ELSEIF (clvari(1:6) .eq. 'IGNOUT' ) THEN
+            ig_direct_nfield = ig_direct_nfield + 1
+            lg_state(jf) = .false.
+            ig_total_state(jf) = ip_ignout
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get restart file name 
+            cg_restart_file(jf) = clvari
+        ELSEIF (clvari(1:9).eq. 'AUXILARY') THEN  
+            ig_nfield = ig_nfield + 1
+            lg_state(jf) = .true.
+            ig_number_field(jf) = ig_nfield
+            ig_total_state(jf) = ip_auxilary
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get restart file name
+            cg_restart_file(jf) = clvari
+        ELSEIF (clvari(1:5) .eq. 'INPUT') THEN
+            ig_direct_nfield = ig_direct_nfield + 1
+            lg_state(jf) = .false.
+            ig_total_state(jf) = ip_input
+            CALL parse(clline, clvari, 6, jpeighty, ilen)
+            !* Get input file name
+            cg_input_file(jf) = clvari
+        ENDIF
+    ENDIF
+    IF (lg_state(jf)) THEN
+        IF (ig_total_ntrans(jf) .eq. 0) THEN
+            IF (mpi_rank_global == 0) THEN
+                WRITE (UNIT = nulprt1,FMT = *) &
+                   'If there is no analysis for the field',jf, &
+                   'then the status must not be "EXPORTED"' 
+                WRITE (UNIT = nulprt1,FMT = *)' "AUXILARY" or "EXPOUT" '
+                WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+                CALL oasis_flush(nulprt1)
+            ENDIF
+            CALL OASIS_ABORT_NOARG() 
+        ENDIF
+        READ (UNIT = nulin,FMT = 2002) clline
+        CALL skip(clline, jpeighty)
+        READ (UNIT = nulin,FMT = 2002) clline
+        CALL skip(clline, jpeighty)
+        READ (UNIT = nulin,FMT = 2002)clline_aux
+        DO ja=1,ig_total_ntrans(jf)
+          CALL parse(clline_aux, clvari, ja, jpeighty, ilen)
+          IF (clvari.eq.'CORRECT'.or.clvari.eq.'BLASOLD'.or. &
+             clvari.eq.'BLASNEW') THEN
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL parse(clline, clvari, 2, jpeighty, ilen)
+              READ(clvari,FMT = 2003) il_aux
+              DO ib = 1, il_aux
+                READ (UNIT = nulin,FMT = 2002) clline
+                CALL skip(clline, jpeighty)
+              ENDDO
+          ELSE IF (clvari.eq.'NOINTERP') THEN
+              CONTINUE
+          ELSE
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+          ENDIF
+        ENDDO
+    ELSE
+        IF (ig_total_state(jf) .ne. ip_input) THEN
+            READ (UNIT = nulin,FMT = 2002) clline
+            CALL skip(clline, jpeighty)
+        ENDIF
+        IF (ig_total_state(jf) .ne. ip_input .and.  &
+           ig_total_ntrans(jf) .gt. 0 ) THEN
+            READ (UNIT = nulin,FMT = 2002) clline
+            CALL parse(clline, clvari, 1, jpeighty, ilen)
+            IF (clvari(1:8) .ne. 'LOCTRANS') THEN
+                IF (mpi_rank_global == 0) THEN
+                    WRITE (UNIT = nulprt1,FMT = *) &
+                       'You want a transformation which is not available !'
+                    WRITE (UNIT = nulprt1,FMT = *) &
+                       'Only local transformations are available for '
+                    WRITE (UNIT = nulprt1,FMT = *) &
+                       'fields exchanged directly or output fields '
+                    WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                    WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+                    CALL oasis_flush(nulprt1)
+                ENDIF
+                CALL OASIS_ABORT_NOARG() 
+            ENDIF
+            DO ja=1,ig_total_ntrans(jf)
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+            ENDDO
+        ENDIF
+    ENDIF
+
+240 CONTINUE
+    !* Verify we're at the end of the namcouple, if not STOP (tcraig, june 2012)
+243 READ (UNIT = nulin,FMT = 2002, END=242) clline
+    CALL skip(clline, jpeighty,endflag)
+    if (endflag .EQV. .true.) goto 242
+    CALL parse(clline, clvari, 1, jpeighty, ilen)
+    IF (trim(clvari) .eq. "$END") goto 243
+    goto 241       
+242 CONTINUE
+    IF (ig_nfield.eq.0) THEN
+        lg_oasis_field = .false.
+        IF (mpi_rank_global == 0) THEN
+            WRITE (nulprt1,*)'==> All the fields are exchanged directly'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+    ENDIF
+
+
+    !* Number of different restart files
+
+    allocate (cl_aux(ig_total_nfield))
+    cl_aux(:)=' '
+    DO jf = 1,ig_total_nfield
+      IF (jf.eq.1) THEN
+          cl_aux(1) = cg_restart_file(1)
+          il_aux = 1
+      ELSEIF (jf.gt.1) THEN
+          IF (ALL(cl_aux.ne.cg_restart_file(jf))) THEN
+              il_aux = il_aux + 1  
+              cl_aux(il_aux) = cg_restart_file(jf)
+          ENDIF
+      ENDIF
+    ENDDO
+    deallocate(cl_aux)
+    ig_nbr_rstfile = il_aux
+    
+    IF (lg_oasis_field) THEN
+
+        !*      Alloc array needed for INTERP and initialize them
+
+        ALLOCATE (cintmet(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: cintmet allocation of inipar_alloc',il_err,1)
+        ALLOCATE (naismfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: naismfl allocation of inipar_alloc',il_err,1)
+        ALLOCATE (naismvoi(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: naismvoi allocation of inipar_alloc',il_err,1)
+        ALLOCATE (naisgfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: naisgfl allocation of inipar_alloc',il_err,1)
+        ALLOCATE (naisgvoi(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: naisgvoi allocation of inipar_alloc',il_err,1)
+        cintmet(:)=' '
+        naismfl(:) = 1
+        naismvoi(:) = 1
+        naisgfl(:) = 1
+        naisgvoi(:) = 1
+        !     
+        !*          Alloc arrays needed for EXTRAP and initialize them
+        !     
+        ALLOCATE (cextmet(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: cextmet allocation of inipar_alloc',il_err,1)
+        ALLOCATE (nninnfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout &
+           ('Error: nninnfl allocation of inipar_alloc',il_err,1)
+        ALLOCATE (nninnflg(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout &
+           ('Error: nninnflg allocation of inipar_alloc',il_err,1)
+        ALLOCATE (neighbor(ig_nfield), stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: neighbor allocation of inipar_alloc',il_err,1)
+        ALLOCATE (nextfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nextfl allocation of inipar_alloc',il_err,1)
+        cextmet(:)=' '
+        nninnfl(:) = 1
+        nninnflg(:) = 1
+        neighbor(:) = 1
+        nextfl(:) = 1
+        !     
+        !*          Alloc arrays needed for BLAS... analyses and initialize them 
+        !     
+        ALLOCATE (nbofld(ig_nfield), stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nbofld allocation of inipar_alloc',il_err,1)
+        ALLOCATE (nbnfld(ig_nfield), stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nbnfld allocation of inipar_alloc',il_err,1)
+        nbofld(:) = 1
+        nbnfld(:) = 1
+        !     
+        !*          Alloc arrays needed for MOZAIC and initialize them
+        !     
+        ALLOCATE (nmapvoi(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nmapvoi allocation of  inipar_alloc',il_err,1)
+        ALLOCATE (nmapfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nmapfl allocation of inipar_alloc',il_err,1)
+        nmapvoi(:) = 1
+        nmapfl(:) = 1
+        !     
+        !*          Alloc arrays needed for SUBGRID and initialize them
+        !     
+        ALLOCATE (nsubfl(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nsubfl allocation of inipar_alloc',il_err,1)
+        ALLOCATE (nsubvoi(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nsubvoi allocation of inipar_alloc',il_err,1)
+        nsubfl(:) = 1
+        nsubvoi(:) = 1
+        !     
+        !*          Alloc arrays needed for GLORED and REDGLO and initialize them 
+        !     
+        ALLOCATE (ntronca(ig_nfield), stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: ntronca allocation of inipar_alloc',il_err,1)
+        ntronca(:) = 0
+
+        !     
+        !*          Alloc array needed for analyses parameters 
+        !     
+        ALLOCATE (cficbf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: cficbf allocation of inipar_alloc',il_err,1)
+        cficbf(:)=' '
+        ALLOCATE (cficaf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: cficaf allocation of inipar_alloc',il_err,1)
+        cficaf(:)=' '
+        !     
+        !*         Alloc arrays needed for grid dimensions of direct fields and 
+        !*         indirect fields
+        !     
+        ALLOCATE (nlonbf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nlonbf allocation of inipar_alloc',il_err,1)
+        nlonbf(:)=0
+        ALLOCATE (nlatbf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nlatbf allocation of inipar_alloc',il_err,1)
+        nlatbf(:)=0
+        ALLOCATE (nlonaf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nlonaf allocation of inipar_alloc',il_err,1)
+        nlonaf(:)=0
+        ALLOCATE (nlataf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: nlataf allocation of inipar_alloc',il_err,1)
+        nlataf(:)=0
+        !     
+        !*         Alloc arrays needed for grid number associated to each field
+
+        ALLOCATE (ig_grid_nbrbf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: ig_grid_nbrbf allocation of inipar_alloc',il_err,1)
+        ig_grid_nbrbf(:)=0
+        ALLOCATE (ig_grid_nbraf(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: ig_grid_nbraf allocation of inipar_alloc',il_err,1)
+        ig_grid_nbraf(:)=0
+
+        !     
+        !*          Alloc number of analyses array 
+        !     
+        ALLOCATE (ig_ntrans(ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: ig_ntrans allocation of inipar_alloc',il_err,1)
+        ig_ntrans(:)=0
+        DO ib = 1, ig_total_nfield
+          IF (lg_state(ib)) &
+             ig_ntrans(ig_number_field(ib))=ig_total_ntrans(ib)
+        ENDDO
+        !     
+        !*          Maximum number of analyses 
+        !     
+        il_maxanal = maxval(ig_ntrans)
+        !     
+        !*          Alloc array of restart file names
+        !     
+        ALLOCATE (cficinp(ig_nfield), stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: cficinp allocation of inipar_alloc',il_err,1)
+        cficinp(:)=' '
+        DO ib = 1, ig_total_nfield
+          IF (lg_state(ib))  &
+             cficinp(ig_number_field(ib))=cg_restart_file(ib)
+        END DO
+#ifdef use_netCDF
+        !tcx?
+        !            istatus=NF_OPEN(cg_restart_file(1), NF_NOWRITE, il_id)
+        !            IF (istatus .eq. NF_NOERR) THEN
+        !                lncdfrst = .true.
+        !            ELSE
+#endif
+        lncdfrst = .false.
+#ifdef use_netCDF
+        !            ENDIF
+        !            istatus=NF_CLOSE(il_id)
+#endif
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1, *) 'lncdfrst =', lncdfrst
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        !     
+        !*          Alloc array needed to get analysis names
+
+        ALLOCATE (canal(il_maxanal,ig_nfield),stat=il_err)
+        IF (il_err.NE.0) CALL prtout  &
+           ('Error: canal allocation of inipar_alloc',il_err,1)
+        canal(:,:)=' '
+    ENDIF
+
+    !*      Get analysis parameters 
+
+    REWIND nulin
+221 CONTINUE
+    READ (UNIT = nulin,FMT = 2001,END = 230) clword
+    IF (clword .NE. clstring) GO TO 221
+
+    !*      Loop on total number of fields (NoF)
+    !      
+    DO 250 jf=1,ig_total_nfield
+
+      !*        Initialization
+
+      nlonbf_notnc = 0
+      nlatbf_notnc = 0
+      nlonaf_notnc = 0
+      nlataf_notnc = 0
+
+      !*        Skip first line read before
+
+      READ (UNIT = nulin,FMT = 2002) clline
+      CALL skip(clline, jpeighty)
+      !     
+      !* Second line
+
+      !* In the indirect case, reading of second, third, fourth line and analyses 
+      !* lines
+
+      IF (ig_total_state(jf) .NE. ip_input) THEN
+          READ (UNIT = nulin,FMT = 2002) clline
+          !*            First determine what information is on the line
+          CALL parse(clline, clvari, 3, jpeighty, ILEN)
+          IF (ILEN .LT. 0) THEN
+              !*                  
+              !*                IF only two words on the line, then they are the locator 
+              !*                prefixes and the grids file must be in NetCDF format       
+              CALL parse(clline, clvari, 1, jpeighty, ilen)
+              IF (lg_state(jf))  &
+                 cficbf(ig_number_field(jf)) = clvari
+              cga_locatorbf(jf) = clvari(1:4)
+              CALL parse(clline, clvari, 2, jpeighty, ilen)
+              IF (lg_state(jf)) &
+                 cficaf(ig_number_field(jf)) = clvari
+              cga_locatoraf(jf) = clvari(1:4)
+              lncdfgrd = .true.
+          ELSE 
+              READ(clvari,FMT = 2010) clind, clequa, iind
+              IF (clind .EQ. 'SEQ' .OR. clind .EQ. 'LAG' .AND. &
+                 clequa .EQ. '=') THEN
+                  
+                  !*                    If 3rd word is an index, then first two words are 
+                  !*                    locator prefixes and grids file must be NetCDF format
+                  CALL parse(clline, clvari, 1, jpeighty, ILEN) 
+                  IF (lg_state(jf))  &
+                     cficbf(ig_number_field(jf)) = clvari 
+                  cga_locatorbf(jf) = clvari(1:4)
+                  CALL parse(clline, clvari, 2, jpeighty, ILEN)
+                  IF (lg_state(jf))  &
+                     cficaf(ig_number_field(jf)) = clvari
+                  cga_locatoraf(jf) = clvari(1:4)
+                  lncdfgrd = .TRUE.
+              ELSE
+                  !*              If not, the first 4 words are grid dimensions and next
+                  !*              2 words are locator prefixes, and grids file may be or
+                  !*              not in NetCDF format 
+                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
+                  !*                    Get number of longitudes for initial field
+                  IF (mpi_rank_global == 0) THEN
+                      WRITE(nulprt1,*)'CLVARI=',clvari
+                      CALL oasis_flush(nulprt1) 
+                  ENDIF
+                  READ(clvari,FMT = 2004) nlonbf_notnc
+                  CALL parse(clline, clvari, 2, jpeighty, ilen)
+                  !*                    Get number of latitudes for initial field
+                  READ(clvari,FMT = 2004) nlatbf_notnc
+                  CALL parse(clline, clvari, 3, jpeighty, ilen)
+                  !*                    Get number of longitudes for final field
+                  READ(clvari,FMT = 2004) nlonaf_notnc
+                  CALL parse(clline, clvari, 4, jpeighty, ilen)
+                  !*                    Get number of latitudes for final field
+                  READ(clvari,FMT = 2004) nlataf_notnc
+                  CALL parse(clline, clvari, 5, jpeighty, ilen)
+                  !*                    Get root name grid-related files (initial field)
+                  IF (lg_state(jf))  &
+                     cficbf(ig_number_field(jf)) = clvari
+                  cga_locatorbf(jf) = clvari(1:4)
+                  CALL parse(clline, clvari, 6, jpeighty, ilen)
+                  !*                    Get root name for grid-related files (final field)
+                  IF (lg_state(jf))  &
+                     cficaf(ig_number_field(jf)) = clvari
+                  cga_locatoraf(jf) = clvari(1:4)
+                  nlonbf(ig_number_field(jf)) = nlonbf_notnc
+                  nlatbf(ig_number_field(jf)) = nlatbf_notnc
+                  nlonaf(ig_number_field(jf)) = nlonaf_notnc
+                  nlataf(ig_number_field(jf)) = nlataf_notnc
+
+              ENDIF
+          ENDIF
+          
+          !*           Read the P 2 P 0 line for exported, expout or auxilary
+          
+          IF (lg_state(jf)) THEN
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+          ENDIF
+          !     
+          !*            Read next line of strings
+          !             --->>> Stuff related to field transformation
+
+          IF (ig_total_ntrans(jf) .GT. 0) THEN 
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+              DO 260 ja = 1, ig_total_ntrans(jf)
+                CALL parse(clline, clvari, ja, jpeighty, ILEN)
+                !*              Get the whole set of analysis to be performed
+                IF (lg_state(jf))  &
+                   canal(ja,ig_number_field(jf)) = clvari
+260           CONTINUE
+              DO 270 ja = 1, ig_total_ntrans(jf)
+                !
+                IF (lg_state(jf)) THEN
+                    cg_c=canal(ja,ig_number_field(jf))
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE(nulprt1,*)'LG_STATE cg_c=', clline
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    IF (cg_c .EQ. 'NOINTERP' .OR. cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INVERT' .OR. &
+                       cg_c .EQ. 'MASK' .OR. cg_c .EQ. 'EXTRAP' .OR. cg_c .EQ. 'CORRECT' .OR. &
+                       cg_c .EQ. 'REDGLO' .OR. cg_c .EQ. 'INTERP' .OR. cg_c .EQ. 'MOZAIC' .OR. &
+                       cg_c .EQ. 'FILLING' .OR. cg_c .EQ. 'MASKP' .OR. cg_c .EQ. 'REVERSE' .OR. &
+                       cg_c .EQ. 'GLORED') THEN
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE(UNIT = nulprt1,FMT = *)'  ***ERROR***'
+                            WRITE(UNIT = nulprt1,FMT = *)' OBSOLETE OPERATION= ', cg_c
+                            WRITE(UNIT = nulprt1,FMT = *)' SPECIFIED IN THE namcouple'
+                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                            CALL oasis_flush(nulprt1)
+                        ENDIF
+                        CALL OASIS_ABORT_NOARG()
+                    ENDIF
+                    READ (UNIT = nulin,FMT = 2002) clline
+                    CALL skip(clline, jpeighty)
+                    IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR')THEN
+                        !* Get field type (scalar/vector)
+                        CALL parse(clline, clvari, 3, jpeighty, ILEN)
+                        READ(clvari,FMT = 2009) clstrg
+                    ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
+                        CALL parse(clline, clvari, 2, jpeighty, ILEN)
+                        !* Get number of additional fields in linear formula
+                        READ(clvari,FMT = 2003) nbofld (ig_number_field(jf))
+                        DO ib = 1,nbofld (ig_number_field(jf))
+                          READ (UNIT = nulin,FMT = 2002) clline
+                          CALL skip(clline, jpeighty)
+                        ENDDO
+                    ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
+                        CALL parse(clline, clvari, 2, jpeighty, ILEN)
+                        !* Get number of additional fields in linear formula
+                        READ(clvari,FMT = 2003) nbnfld (ig_number_field(jf))
+                        DO ib = 1,nbnfld (ig_number_field(jf))
+                          READ (UNIT = nulin,FMT = 2002) clline
+                          CALL skip(clline, jpeighty)
+                        ENDDO
+                    ENDIF
+                ELSE
+                    ! For IGNORED, IGNOUT and OUTPUT, only one line for LOCTRANS
+                    READ (UNIT = nulin,FMT = 2002) clline
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE(nulprt1,*)'OUTPUT clline=', clline
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL skip(clline, jpeighty)
+                ENDIF
+270           CONTINUE
+                ! 
+          ENDIF         ! IF (ig_total_ntrans(jf) .GT. 0) THEN 
+      ENDIF  !IF (ig_total_state(jf) .NE. ip_input) THEN
+      !
+250 CONTINUE
+
+    IF (lg_oasis_field) THEN 
+        !     
+        !*       Search maximum number of fields to be combined in the BLASxxx analyses
+        !     
+        ig_maxcomb = MAXVAL(nbofld)
+        IF (MAXVAL(nbnfld).GT.ig_maxcomb) &
+           ig_maxcomb = MAXVAL(nbnfld)
+        !
+        !*          Search maximum number of neighbors for GAUSSIAN interpolation
+        !     
+        ig_maxnoa = MAXVAL(naisgvoi)
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) &
+               'Max number of neighbors for GAUSSIAN interp : ', &
+               ig_maxnoa
+            WRITE(nulprt1,*)' '
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        !     
+        !*          Search maximum number of different GAUSSIAN interpolations
+        !     
+        ig_maxnfg = MAXVAL(naisgfl)
+        IF (mpi_rank_global == 0) THEN
+            WRITE(nulprt1,*) &
+               'Maximum number of different GAUSSIAN interpolations : ', &
+               ig_maxnfg
+            WRITE(nulprt1,*)' '
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        ! 
+    ENDIF
+    !*    Formats
+
+2001    FORMAT(A9)
+2002    FORMAT(A1000)
+2003    FORMAT(I4)
+2004    FORMAT(I8)
+2009    FORMAT(A8)
+2010    FORMAT(A3,A1,I2)
+
+    !*    3. End of routine
+    !        --------------
+    
+    IF (mpi_rank_global == 0) THEN
+        WRITE(UNIT = nulprt1,FMT = *)' '
+        WRITE(UNIT = nulprt1,FMT = *)'-- End of ROUTINE inipar_alloc --'
+        CALL oasis_flush (nulprt1)
+    ENDIF
+
+    !      call oasis_debug_exit(subname)
+    RETURN
+    
+    !*    Error branch output
+    
+110 CONTINUE
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+        WRITE (UNIT = nulprt1,FMT = *) &
+           ' Problem with $NBMODEL in input file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' We STOP!!! Check the file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+        CALL oasis_flush(nulprt1)
+    ENDIF
+    CALL oasis_abort_noarg()
+210 CONTINUE
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' No active $FIELDS data found in input file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' We STOP!!! Check the file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+        CALL oasis_flush(nulprt1)
+    ENDIF
+    CALL oasis_abort_noarg()
+230 CONTINUE
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' No active $STRING data found in input file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' We STOP!!! Check the file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+        CALL oasis_flush(nulprt1)
+    ENDIF
+    CALL oasis_abort_noarg()
+232 CONTINUE
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT = *) subname,':   ***WARNING***'
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' size clline smaller than the size of the names of the fields on the line'
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' increase jpeighty and change the associated format A(jpeighty) and cline'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' We STOP!!! Check the file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+        CALL oasis_flush(nulprt1)
+    ENDIF
+    CALL oasis_abort_noarg()
+241 CONTINUE
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' NFIELDS larger or smaller than the number of inputs in namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (UNIT = nulprt1,FMT = *)  &
+           ' We STOP!!! Check the file namcouple'
+        WRITE (UNIT = nulprt1,FMT = *) ' '
+        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+        WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+        CALL oasis_flush(nulprt1)
+    ENDIF
+    CALL oasis_abort_noarg()
+
+  END SUBROUTINE inipar_alloc
+
+!===============================================================================
+
+  SUBROUTINE inipar
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL 0 *
+!               * -------------     ------- *
+!               *****************************
+
+!**** *inipar*  - Get run parameters
+
+!     Purpose:
+!     -------
+!     Reads and prints out run parameters.
+
+!**   Interface:
+!     ---------
+!       *CALL*  *inipar*
+
+!     Input:
+!     -----
+!     None
+
+!     Output:
+!     ------
+!     None
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+  IMPLICIT NONE
+
+!* ---------------------------- Local declarations --------------------
+  
+  CHARACTER*1000 clline, clvari
+  CHARACTER*9 clword, clstring, clprint, clcal, clchan
+  CHARACTER*9 cljob, clmod, cltime, clseq, cldate, clhead
+  CHARACTER*8 cl_print_trans, cl_print_state
+  CHARACTER*3 clinfo, clind
+  CHARACTER*1 clequa
+  CHARACTER*64 cl_cfname,cl_cfunit
+  INTEGER (kind=ip_intwp_p) iind, il_aux
+  INTEGER (kind=ip_intwp_p) il_file_unit, id_error
+  INTEGER (kind=ip_intwp_p) il_max_entry_id, il_no_of_entries
+  INTEGER (kind=ip_intwp_p) il_i, il_pos
+  LOGICAL llseq, lllag, ll_exist
+  INTEGER lastplace
+  integer (kind=ip_intwp_p) :: ib,ilind1,ilind2,ilind
+  integer (kind=ip_intwp_p) :: ja,jf,jfn,jz,jm,ilen,idum
+  integer (kind=ip_intwp_p) :: ifca,ifcb,ilab,jff,jc
+  integer (kind=ip_intwp_p) :: icofld,imodel
+  character(len=*),parameter :: subname='mod_oasis_namcouple:inipar'
+
+!* ---------------------------- Poema verses --------------------------
+
+!  call oasis_debug_enter(subname)
+
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+!*    1. Get basic info for the simulation 
+!        ---------------------------------
+
+  IF (mpi_rank_global == 0) THEN
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)'   ROUTINE inipar  -  Level 0'
+      WRITE (UNIT = nulprt1,FMT = *)'   **************     *******'
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      WRITE (UNIT = nulprt1,FMT = *)'   Initialization of run parameters'
+      WRITE (UNIT = nulprt1,FMT = *)'   Reading input file namcouple'
+      WRITE (UNIT = nulprt1,FMT = *)' '
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+!* Initialize character keywords to locate appropriate input
+
+  clstring = ' $STRINGS'
+  cljob    = ' $JOBNAME'
+  clchan   = ' $CHANNEL'
+  clmod    = ' $NBMODEL'
+  cltime   = ' $RUNTIME'
+  clseq    = ' $SEQMODE'
+  cldate   = ' $INIDATE'
+  clhead   = ' $MODINFO'
+  clprint  = ' $NLOGPRT'
+  clcal    = ' $CALTYPE'
+
+  !* Initialize some variables 
+  ntime = 0 ; niter = 5 
+  nstep = 86400 ; nitfn=4
+
+  !* First get experiment name 
+
+  REWIND nulin
+100 CONTINUE
+  READ (UNIT = nulin,FMT = 1001,END = 110) clword
+  IF (clword .NE. cljob) GO TO 100
+  IF (mpi_rank_global == 0) THEN
+      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+      WRITE (UNIT = nulprt1,FMT = *) 'Information below $JOBNAME'
+      WRITE (UNIT = nulprt1,FMT = *) 'is obsolote in OASIS3-MCT'
+      WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+110 CONTINUE
+  
+  !* Get number of models involved in this simulation
+  
+  REWIND nulin
+120 CONTINUE
+  READ (UNIT = nulin,FMT = 1001,END = 130) clword
+  IF (clword .NE. clmod) GO TO 120
+  READ (UNIT = nulin,FMT = 1002) clline
+
+  !* Get model names
+
+  DO 140 jm = 1, ig_nmodel
+    imodel = jm + 1
+    CALL parse (clline, clvari, imodel, jpeighty, ilen)
+    cmodnam(jm) = clvari
+
+    !* Print out model names
+
+    IF (mpi_rank_global == 0) THEN
+        WRITE (UNIT = nulprt1,FMT =' &
+           &        (''   Name for model '',I1,'' is '',A6,/)')  &
+           jm, cmodnam(jm)
+        CALL oasis_flush(nulprt1)
+    ENDIF
+
+140 CONTINUE
+
+  !* Get model maximum unit number used if they appear on the line
+
+  DO 142 jm = 1, ig_nmodel
+    imodel = jm + 1 + ig_nmodel
+    CALL parse (clline, clvari, imodel, jpeighty, ILEN)
+    IF (ILEN .GT. 0) THEN
+        READ (clvari,FMT = 1004) iga_unitmod(jm)
+        
+        !* Print out model minimum logfile unit number
+        IF (mpi_rank_global == 0) THEN
+            WRITE (UNIT = nulprt1,FMT = *) ' '
+            WRITE (UNIT=nulprt1,FMT=*) &
+                'The maximum Fortran unit number used in model is', &
+                 jm, iga_unitmod(jm)
+            WRITE (UNIT = nulprt1,FMT = *) ' '
+            CALL oasis_flush(nulprt1)
+        ENDIF
+
+        !* Verify that maximum unit number is larger than 1024; 
+        !* if not, use 1024.
+        IF (iga_unitmod(jm) .lt. 1024) iga_unitmod(jm)=1024
+    ELSE
+        IF (mpi_rank_global == 0) THEN
+            WRITE (UNIT = nulprt1, FMT = *) &
+               ' WARNING: You did not give in the namcouple the maximum', &
+               ' Fortran unit numbers used in your models.', &
+               ' Oasis will suppose that units above 1024 are free !'
+            CALL oasis_flush(nulprt1)
+        ENDIF
+        iga_unitmod(jm)=1024
+    ENDIF
+142 CONTINUE
+
+  !* Get hardware info for this OASIS simulation
+
+   REWIND nulin
+160 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 170) clword
+   IF (clword .NE. clchan) GO TO 160
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+       WRITE (UNIT = nulprt1,FMT = *) 'Information below $CHANNEL'
+       WRITE (UNIT = nulprt1,FMT = *) 'is obsolote in OASIS3-MCT'
+       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+170 CONTINUE
+
+   !* Get total time for this simulation
+
+   REWIND nulin
+190 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 191) clword
+   IF (clword .NE. cltime) GO TO 190
+   READ (UNIT = nulin,FMT = 1002) clline
+   CALL parse (clline, clvari, 1, jpeighty, ilen)
+   IF (ilen .LE. 0) THEN
+       GOTO 191
+   ELSE
+       READ (clvari,FMT = 1004) ntime
+   ENDIF
+
+   !* Print out total time
+
+   CALL prtout &
+      ('The total time for this run is ntime =', ntime, 1)
+
+   !* Get initial date for this simulation
+
+   REWIND nulin
+192 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 193) clword
+   IF (clword .NE. cldate) GO TO 192
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+       WRITE (UNIT = nulprt1,FMT = *) 'Information below $INIDATE'
+       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
+       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+193 CONTINUE
+
+   !* Get number of sequential models involved in this simulation
+
+   REWIND nulin
+194 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 195) clword
+   IF (clword .NE. clseq) GO TO 194
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+       WRITE (UNIT = nulprt1,FMT = *) 'Information below $SEQMODE'
+       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
+       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+195 CONTINUE
+
+   !* Get the information mode for this simulation
+
+   REWIND nulin
+196 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 197) clword
+   IF (clword .NE. clhead) GO TO 196
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+       WRITE (UNIT = nulprt1,FMT = *) 'Information below $MODINFO'
+       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
+       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+197 CONTINUE
+
+   !* Print out the information mode
+
+   CALL prcout &
+      ('The information mode is activated ? ==>', clinfo, 1)
+
+   !* Get the printing level for this simulation
+
+   REWIND nulin
+198 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 199) clword
+   IF (clword .NE. clprint) GO TO 198
+   nlogprt = 2
+   READ (UNIT = nulin,FMT = 1002) clline
+   CALL parse (clline, clvari, 1, jpeighty, ilen)
+   IF (ilen .LE. 0) THEN
+       IF (mpi_rank_global == 0) THEN
+           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' Nothing on input for $NLOGPRT '
+           WRITE (UNIT = nulprt1,FMT = *) ' Default value 2 will be used '
+           WRITE (UNIT = nulprt1,FMT = *) ' '
+           CALL oasis_flush(nulprt1)
+       ENDIF
+   ELSE IF (ilen .gt. 8) THEN
+       IF (mpi_rank_global == 0) THEN
+           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' Input variable length is incorrect'
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' Printing level uncorrectly specified'
+           WRITE (UNIT = nulprt1,FMT = *) ' ilen = ', ILEN  
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' Check $NLOGPRT variable spelling '
+           WRITE (UNIT = nulprt1,FMT = *) ' Default value will be used '
+           CALL oasis_flush(nulprt1)
+       ENDIF
+   ELSE
+       READ (clvari,FMT = 1004) nlogprt
+   ENDIF
+   ntlogprt=0
+   CALL parse (clline, clvari, 2, jpeighty, ilen)
+   IF (ILEN > 0) THEN
+       READ (clvari,FMT = 1004) ntlogprt
+   ELSE
+       IF (mpi_rank_global == 0) THEN
+           WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+           WRITE (UNIT = nulprt1,FMT = *)  &
+              ' Nothing on input for time statistic '
+           WRITE (UNIT = nulprt1,FMT = *) ' Default value 0 will be used '
+           WRITE (UNIT = nulprt1,FMT = *) ' '
+           CALL oasis_flush(nulprt1)
+       ENDIF
+   ENDIF
+
+   !* Print out the printing level
+
+   CALL prtout &
+      ('The printing level is nlogprt =', nlogprt, 1)
+   CALL prtout &
+      ('The time statistics level is ntlogprt =', ntlogprt, 1)
+
+   !* Get the calendar type for this simulation
+
+   REWIND nulin
+200 CONTINUE
+   READ (UNIT = nulin,FMT = 1001,END = 201) clword
+   IF (clword .NE. clcal) GO TO 200
+   IF (mpi_rank_global == 0) THEN
+       WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+       WRITE (UNIT = nulprt1,FMT = *) 'Information below $CALTYPE'
+       WRITE (UNIT = nulprt1,FMT = *) 'is obsolete in OASIS3-MCT'
+       WRITE (UNIT = nulprt1,FMT = *) 'It will not be read and will not be used'
+       CALL oasis_flush(nulprt1)
+   ENDIF
+
+201 CONTINUE
+
+   !* Formats
+
+1001 FORMAT(A9)
+1002 FORMAT(A1000)
+1003 FORMAT(I3)
+1004 FORMAT(I8)
+
+   !*    2. Get field information
+   !        ---------------------
+
+   !* Init. array needed for local transformation  
+
+   ig_local_trans(:) = ip_instant
+
+!SV More cleaning is needed form here on.
+
+!* Init. arrays needed for ANAIS(G-M),mapping and subgrid interpolation
+
+      IF (lg_oasis_field) THEN
+         lcoast = .TRUE.
+         DO 215 jz = 1, ig_nfield
+            linit(jz) = .TRUE.
+            lmapp(jz) = .TRUE.
+            lsubg(jz) = .TRUE.
+            lextra(jz) = .TRUE.
+            varmul(jz) = 1.
+            lsurf(jz) = .FALSE.
+ 215     CONTINUE 
+!     
+      ENDIF
+
+!* Get the SSCS for all fields
+
+      REWIND nulin
+ 220  CONTINUE
+      READ (UNIT = nulin,FMT = 2001,END = 230) clword
+      IF (clword .NE. clstring) GO TO 220
+
+!  Initialize restart name index
+
+      il_aux = 0
+
+!* Loop on total number of fields (NoF)
+
+      DO 240 jf = 1, ig_total_nfield
+
+!* Read first two lines of strings for field n = 1,2...,ig_total_nfield
+!      --->>> Main characteristics of fields
+
+!* First line
+
+         READ (UNIT = nulin,FMT = 2002) clline
+         CALL parse(clline, clvari, 1, jpeighty, ilen)
+!* Get output field symbolic name
+         cg_input_field(jf) = clvari
+         IF (lg_state(jf)) cnaminp(ig_number_field(jf)) = cg_input_field(jf)
+         IF (lg_state(jf)) cnamout(ig_number_field(jf)) = cg_output_field(jf)
+         CALL parse(clline, clvari, 3, jpeighty, ilen)
+!* Get field label number
+         READ (clvari,FMT = 2003) ig_numlab(jf)
+         IF (lg_state(jf)) numlab(ig_number_field(jf)) = ig_numlab(jf)
+         CALL parse(clline, clvari, 4, jpeighty, ilen)
+!* Get field exchange frequency
+         IF (clvari(1:4) .EQ. 'ONCE') THEN
+
+!* The case 'ONCE' means that the coupling period will be equal to the 
+!* time of the simulation
+
+            ig_freq(jf) = ntime
+         ELSE
+         READ (clvari,FMT = 2004) ig_freq(jf)
+         IF (ig_freq(jf) .EQ. 0) THEN
+            GOTO 236
+         ELSEIF (ig_freq(jf) .gt. ntime) THEN
+             IF (mpi_rank_global == 0) THEN
+                 WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+                 WRITE (UNIT = nulprt1,FMT = *)  &
+                    'The coupling period of the field ',jf
+                 WRITE (UNIT = nulprt1,FMT = *)  &
+                    'is greater than the time of the simulation '
+                 WRITE (UNIT = nulprt1,FMT = *)  &
+                    'This field will not be exchanged !'
+                 CALL oasis_flush(nulprt1)
+             ENDIF
+         ENDIF
+     ENDIF
+         IF (lg_state(jf)) nfexch(ig_number_field(jf)) = ig_freq(jf)
+!* Fill up restart file number and restart file name arrays
+         IF (cg_restart_file(jf).ne.' ') THEN
+             IF (jf.eq.1) THEN
+                 il_aux = il_aux + 1
+                 ig_no_rstfile(jf) = il_aux
+                 cg_name_rstfile (ig_no_rstfile(jf)) =  &
+                     cg_restart_file(jf)
+             ELSEIF (jf.gt.1) THEN
+                 IF (ALL(cg_name_rstfile.ne.cg_restart_file(jf))) THEN
+                     il_aux = il_aux + 1
+                     ig_no_rstfile(jf) = il_aux
+                     cg_name_rstfile (ig_no_rstfile(jf))=  &
+                         cg_restart_file(jf)
+                 ELSE 
+                     DO ib = 1, jf - 1 
+                       IF(cg_name_rstfile(ig_no_rstfile(ib)).eq. &
+                           cg_restart_file(jf)) THEN
+                           ig_no_rstfile(jf) = ig_no_rstfile(ib)
+                       ENDIF
+                     ENDDO
+                 ENDIF
+             ENDIF
+         ENDIF
+         CALL parse(clline, clvari, 7, jpeighty, ilen)
+!*
+!* Get the field STATUS
+             IF (clvari(1:8).eq.'EXPORTED' .or.  &
+                 clvari(1:8).eq.'AUXILARY') THEN
+                 cstate(ig_number_field(jf)) = clvari
+             ELSEIF (clvari(1:6) .eq. 'EXPOUT') THEN
+                 cstate(ig_number_field(jf)) = 'EXPORTED'
+             ENDIF
+!*
+!* Second line
+! XXX Modif Graham ?
+
+        IF (ig_total_state(jf) .ne. ip_input) THEN
+           READ (UNIT = nulin,FMT = 2002) clline
+!     *      First determine what information is on the line
+           CALL parse(clline, clvari, 3, jpeighty, ilen)
+           IF (ilen .lt. 0) THEN
+!     *          IF only two words on the line, then they are the locator 
+!     *          prefixes and the grids file must be in NetCDF format       
+              ig_lag(jf)=0
+              ig_total_nseqn(jf)=1
+              IF (lg_state(jf)) then
+                  nseqn(ig_number_field(jf)) = 1
+                  nlagn(ig_number_field(jf)) = 0
+              ENDIF
+              llseq=.FALSE.
+              lllag=.FALSE.
+              IF (mpi_rank_global == 0) THEN
+                  WRITE (UNIT=nulprt1,FMT=3043) jf
+              ENDIF
+           ELSE 
+              READ(clvari,FMT = 2011) clind, clequa, iind
+              IF (clind .EQ. 'SEQ' .or. clind .EQ. 'LAG' .and. &
+                   clequa .EQ. '=') THEN
+!     *              If 3rd word is an index, then first two words are 
+!     *              locator prefixes and grids file must be NetCDF format
+                 ilind1=3
+                 ilind2=6
+              ELSE
+!     *              If not, the first 4 words are grid dimensions and next
+!     *              2 words are locator prefixes, and grids file may be or
+!     *              not in NetCDF FORMAT.
+                 ilind1=7
+                 ilind2=10
+              ENDIF
+!     *          Get possibly additional indices
+              ig_lag(jf)=0
+              ig_total_nseqn(jf)=1
+              IF (lg_state(jf)) then
+                  nseqn(ig_number_field(jf)) = 1
+                  nlagn(ig_number_field(jf)) = 0
+              ENDIF
+              llseq=.FALSE.
+              lllag=.FALSE.
+!     
+              DO 245 ilind=ilind1, ilind2
+                 CALL parse(clline, clvari, ilind, jpeighty, ilen)
+                 IF(ilen .eq. -1) THEN
+                     IF (mpi_rank_global == 0) THEN
+                         IF (nlogprt .GE. 0) THEN 
+                             IF(.NOT. lllag) WRITE (UNIT=nulprt1,FMT=3043) jf
+                         ENDIF
+                     ENDIF
+                    GO TO 247
+                 ELSE
+                    READ(clvari,FMT = 2011) clind, clequa, iind
+                    IF (clind .EQ. 'SEQ') THEN
+                        ig_total_nseqn(jf)=iind
+                        IF (lg_state(jf)) &
+                           nseqn(ig_number_field(jf)) = iind
+                        llseq=.TRUE.
+                    ELSE IF (clind .eq. 'LAG') THEN
+                       ig_lag(jf)=iind
+                       IF (lg_state(jf)) &
+                           nlagn(ig_number_field(jf)) = iind
+                       lllag=.TRUE.
+                       IF (mpi_rank_global == 0) THEN
+                           WRITE (UNIT = nulprt1,FMT = 3044)jf,ig_lag(jf)
+                       ENDIF
+                    ENDIF              
+                 ENDIF
+ 245          CONTINUE
+          ENDIF
+       ENDIF
+
+
+ 247   CONTINUE
+
+!* Third line
+
+       IF (lg_state(jf)) THEN
+           READ (UNIT = nulin,FMT = 2002) clline
+           CALL parse(clline, clvari, 1, jpeighty, ILEN)
+           !     * Get source grid periodicity type
+           csper(ig_number_field(jf)) = clvari
+           IF(csper(ig_number_field(jf)) .NE. 'P' .AND.  &
+              csper(ig_number_field(jf)) .NE. 'R') THEN
+               CALL prtout &
+                  ('ERROR in namcouple for source grid type of field', jf, 1)
+               IF (mpi_rank_global == 0) THEN
+                   WRITE (UNIT = nulprt1,FMT = *) '==> must be P or R'
+                   WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                   WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                   CALL oasis_flush(nulprt1)
+               ENDIF
+               CALL OASIS_ABORT_NOARG()
+           ENDIF
+!     
+           CALL parse(clline, clvari, 2, jpeighty, ilen)
+!     * Get nbr of overlapped longitudes for the Periodic type source grid
+           READ(clvari,FMT = 2005) nosper(ig_number_field(jf))
+           CALL parse(clline, clvari, 3, jpeighty, ilen)
+!     * Get target grid periodicity type
+           ctper(ig_number_field(jf)) = clvari
+           IF(ctper(ig_number_field(jf)) .NE. 'P' .AND.  &
+                ctper(ig_number_field(jf)) .NE. 'R') THEN
+              CALL prtout &
+            ('ERROR in namcouple for target grid type of field', jf, 1)
+              IF (mpi_rank_global == 0) THEN
+                  WRITE (UNIT = nulprt1,FMT = *) '==> must be P or R'
+                  WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                  WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                  CALL oasis_flush(nulprt1)
+              ENDIF
+              CALL OASIS_ABORT_NOARG()
+           ENDIF
+!     
+           CALL parse(clline, clvari, 4, jpeighty, ilen)
+!     * Get nbr of overlapped longitudes for the Periodic type target grid
+           READ(clvari,FMT = 2005) notper(ig_number_field(jf))
+!     
+       ENDIF
+
+       !* Get the local transformation
+
+       IF (.NOT. lg_state(jf)) THEN
+           IF (ig_total_state(jf) .ne. ip_input .and.  &
+                ig_total_ntrans(jf) .gt. 0 ) THEN
+              READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+              DO ja=1,ig_total_ntrans(jf)
+                 READ (UNIT = nulin,FMT = 2002) clline 
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+                 IF (clvari(1:7) .eq. 'INSTANT') THEN 
+                    ig_local_trans(jf) = ip_instant
+                 ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
+                    ig_local_trans(jf) = ip_average
+                 ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
+                    ig_local_trans(jf) = ip_accumul
+                 ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
+                    ig_local_trans(jf) = ip_min
+                 ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
+                    ig_local_trans(jf) = ip_max   
+                 ELSE
+                    CALL prtout &
+       ('ERROR in namcouple for local transformations of field', jf, 1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *)  &
+                           '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG()  
+                 ENDIF
+              ENDDO
+           ENDIF
+       ELSE
+         READ (UNIT = nulin,FMT = 2002) clline
+              CALL skip(clline, jpeighty)
+!     
+!     * Now read specifics for each transformation
+ 
+           DO 270 ja = 1, ig_ntrans(ig_number_field(jf))
+!     
+!     * Read next line unless if analysis is NOINTERP (no input)
+!     
+             READ (UNIT = nulin,FMT = 2002) clline
+             CALL skip(clline, jpeighty)
+              IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+                 IF (clvari(1:7) .eq. 'INSTANT') THEN 
+                    ig_local_trans(jf) = ip_instant
+                 ELSEIF (clvari(1:7) .eq. 'AVERAGE') THEN
+                    ig_local_trans(jf) = ip_average
+                 ELSEIF (clvari(1:7) .eq. 'ACCUMUL') THEN
+                    ig_local_trans(jf) = ip_accumul
+                 ELSEIF (clvari(1:5) .eq. 'T_MIN') THEN
+                    ig_local_trans(jf) = ip_min
+                 ELSEIF (clvari(1:5) .eq. 'T_MAX') THEN
+                    ig_local_trans(jf) = ip_max   
+                 ELSE
+                    CALL prtout &
+       ('ERROR in namcouple for local transformations of field', jf, 1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *)  &
+                           '==> Must be INSTANT, AVERAGE, ACCUMUL, T_MIN or T_MAX'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG()  
+                 ENDIF
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN')THEN
+                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT')  THEN
+                  CALL parse(clline, clvari, 1, jpeighty, ILEN)
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
+!* Get mapping filename
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+                 cmap_file(ig_number_field(jf)) = trim(clvari)
+!* Get mapping location and/or mapping optimization; src (default), dst; bfb (default), sum, opt
+                 cmaptyp(ig_number_field(jf)) = 'src'
+                 cmapopt(ig_number_field(jf)) = 'bfb'
+                 do idum = 2,3
+                    CALL parse(clline, clvari, idum, jpeighty, ilen)
+                    if (ilen > 0) then
+                       if (trim(clvari) == 'src' .or. trim(clvari) == 'dst') then
+                          cmaptyp(ig_number_field(jf)) = trim(clvari)
+                       elseif (trim(clvari) == 'opt' .or. trim(clvari) == 'bfb' &
+                          .or. trim(clvari) == 'sum') then
+                          cmapopt(ig_number_field(jf)) = trim(clvari)
+                       else
+                          call prtout ('ERROR in namcouple mapping argument',jf,1)
+                          IF (mpi_rank_global == 0) THEN
+                              WRITE(nulprt1,*) 'ERROR in namcouple mapping argument ',&
+                                                TRIM(clvari)
+                              WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                              WRITE (nulprt1,'(a)') ' error = STOP in inipar cmaptyp or loc'
+                              CALL oasis_flush(nulprt1)
+                          ENDIF
+                          call oasis_abort_noarg()
+                       endif
+                    endif
+                 enddo
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
+!* Get Scrip remapping method
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+                 READ(clvari,FMT = 2009) cmap_method(ig_number_field(jf))
+!* Get source grid type
+                 CALL parse(clline, clvari, 2, jpeighty, ilen)
+                 READ(clvari,FMT = 2009) cgrdtyp(ig_number_field(jf))
+                 IF (cmap_method(ig_number_field(jf)) .eq. 'BICUBIC'  &
+                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
+                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
+                     IF (mpi_rank_global == 0) THEN
+                         WRITE (UNIT = nulprt1,FMT = *) '    '
+                     ENDIF
+                    CALL prtout &
+                      ('ERROR in namcouple for type of field', jf, 1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *)  &
+                           'BICUBIC interpolation cannot be used if grid is not LR or D'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG() 
+                 ENDIF
+                 IF (cmap_method(ig_number_field(jf)) .eq. 'BILINEAR'  &
+                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'LR' &
+                    .and. cgrdtyp(ig_number_field(jf)) .ne. 'D') THEN
+                     IF (mpi_rank_global == 0) THEN
+                         WRITE (UNIT = nulprt1,FMT = *) '    '
+                     ENDIF
+                    CALL prtout &
+                      ('ERROR in namcouple for type of field', jf, 1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *)  &
+                           'BILINEAR interpolation cannot be used if grid is not LR or D'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG() 
+                 ENDIF
+!* Get field type (scalar/vector)
+                 CALL parse(clline, clvari, 3, jpeighty, ilen)
+                 READ(clvari,FMT = 2009) cfldtype(ig_number_field(jf))
+                 IF(cfldtype(ig_number_field(jf)) .EQ. 'VECTOR') &
+                    cfldtype(ig_number_field(jf))='SCALAR'
+                 IF(cfldtype(ig_number_field(jf)) .NE. 'SCALAR') THEN
+                     IF (mpi_rank_global == 0) THEN
+                         WRITE (UNIT = nulprt1,FMT = *) '    '
+                     ENDIF
+                    CALL prtout &
+                      ('ERROR in namcouple for type of field', jf, 1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *)  &
+                           '==> must be SCALAR, VECTOR'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG()
+                 ENDIF
+!* Get restriction type for SCRIP search
+                 CALL parse(clline, clvari, 4, jpeighty, ilen)
+                 READ(clvari,FMT = 2009) crsttype(ig_number_field(jf))
+                 IF (cgrdtyp(ig_number_field(jf)) .EQ. 'D') THEN
+                    IF (cmap_method(ig_number_field(jf)) .EQ. 'BILINEAR' .or. &
+                        cmap_method(ig_number_field(jf)) .EQ. 'BICUBIC') THEN
+                        IF (crsttype(ig_number_field(jf)) .NE. 'LATITUDE') THEN
+                            IF (mpi_rank_global == 0) THEN
+                                WRITE (UNIT = nulprt1,FMT = *) '    '
+                            ENDIF
+                            CALL prtout('ERROR in namcouple for restriction of field',jf,1)
+                            IF (mpi_rank_global == 0) THEN
+                                WRITE (UNIT = nulprt1,FMT = *)  &
+                                   '==> LATITUDE must be chosen for reduced grids (D)'
+                                WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                                WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                                CALL oasis_flush(nulprt1)
+                            ENDIF
+                            CALL OASIS_ABORT_NOARG()
+                        ELSE  
+                            crsttype(ig_number_field(jf)) = 'REDUCED'
+                        ENDIF
+                    ENDIF
+                 ENDIF
+
+                 IF(crsttype(ig_number_field(jf)) .NE. 'LATITUDE' .AND.  &
+                    crsttype(ig_number_field(jf)) .NE. 'LATLON' .AND. &
+                    crsttype(ig_number_field(jf)) .NE. 'REDUCED') THEN
+                     IF (mpi_rank_global == 0) THEN
+                         WRITE (UNIT = nulprt1,FMT = *) '    '
+                     ENDIF
+                    CALL prtout('ERROR in namcouple for restriction of field',jf,1)
+                    IF (mpi_rank_global == 0) THEN
+                        WRITE (UNIT = nulprt1,FMT = *) '==> must be LATITUDE or LATLON'
+                        WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                        WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                        CALL oasis_flush(nulprt1)
+                    ENDIF
+                    CALL OASIS_ABORT_NOARG()
+                 ENDIF
+!*
+!* Get number of search bins for SCRIP search
+                 CALL parse(clline, clvari, 5, jpeighty, ilen)
+                 READ(clvari,FMT = 2003) nbins(ig_number_field(jf))
+!* Get normalize option for CONSERV
+                 IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN
+                    CALL parse(clline, clvari, 6, jpeighty, ilen)
+                    READ(clvari,FMT = 2009)cnorm_opt(ig_number_field(jf))
+                    IF (cnorm_opt(ig_number_field(jf)) .NE. 'FRACAREA' .AND. &
+      		        cnorm_opt(ig_number_field(jf)) .NE. 'DESTAREA' .AND.  &
+                        cnorm_opt(ig_number_field(jf)) .NE. 'FRACNNEI') THEN
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *) '    '
+                        ENDIF
+                        CALL prtout &
+                          ('ERROR in namcouple for normalize option of field',jf,1)
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1, FMT = *)  &
+                               '==> must be FRACAREA, DESTAREA, or FRACNNEI'
+                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                            CALL oasis_flush(nulprt1)
+                        ENDIF
+                        CALL OASIS_ABORT_NOARG()
+                    ENDIF
+!* Get order of remapping for CONSERV
+                    CALL parse(clline, clvari, 7, jpeighty, ilen)
+                    IF (ilen .LE. 0) THEN
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *) '    '
+                        ENDIF
+                        CALL prtout ('ERROR in namcouple for CONSERV for field',jf,1)
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *)  &
+                               '==> FIRST must be indicated at end of line'
+                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                            CALL oasis_flush(nulprt1)
+                        ENDIF
+                        CALL OASIS_ABORT_NOARG()
+                    ENDIF
+                    READ(clvari,FMT = 2009) corder(ig_number_field(jf))                   
+                 ELSE
+                     cnorm_opt(ig_number_field(jf))='NONORM'
+                 ENDIF
+!* Get number of neighbours for DISTWGT and GAUSWGT
+                 IF (cmap_method(ig_number_field(jf)) .EQ. 'DISTWGT' .or. &
+                     cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
+                    CALL parse(clline, clvari, 6, jpeighty, ilen)
+                    IF (ilen .LE. 0) THEN
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *) '    '
+                        ENDIF
+                        CALL prtout('ERROR in namcouple for field',jf,1)
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *)  &
+                               '==> Number of neighbours must be indicated on the line'
+                            WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                            WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                            CALL oasis_flush(nulprt1)
+                        ENDIF
+                       CALL OASIS_ABORT_NOARG()
+                    ELSE
+                       READ(clvari,FMT=2003)nscripvoi(ig_number_field(jf))
+                    ENDIF 
+                 ENDIF
+!* Get gaussian variance for GAUSWGT
+                 IF (cmap_method(ig_number_field(jf)) .EQ. 'GAUSWGT') THEN
+                    CALL parse(clline, clvari, 7, jpeighty, ilen)
+                    IF (ilen .LE. 0) THEN
+                        IF (mpi_rank_global == 0) THEN
+                            WRITE (UNIT = nulprt1,FMT = *) '    '
+                        ENDIF
+                       CALL prtout('ERROR in namcouple for GAUSWGT for field',jf,1)
+                       IF (mpi_rank_global == 0) THEN
+                           WRITE (UNIT = nulprt1,FMT = *)  &
+                              '==> Variance must be indicated at end of line'
+                           WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                           WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                           CALL oasis_flush(nulprt1)
+                       ENDIF
+                       CALL OASIS_ABORT_NOARG()
+                    ELSE
+                       READ(clvari,FMT=2006) varmul(ig_number_field(jf))
+                    ENDIF
+                 ENDIF
+
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'FILLING')  &
+                      THEN
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get data file name (used to complete the initial field array)
+                 cfilfic(ig_number_field(jf)) = clvari
+                 CALL parse(clline, clvari, 2, jpeighty, ilen)
+!     * Get logical unit connected to previous file
+                 READ(clvari,FMT = 2005) nlufil(ig_number_field(jf))
+                 CALL parse(clline, clvari, 3, jpeighty, ilen)
+!     * Get filling method
+                 cfilmet(ig_number_field(jf)) = clvari
+!     * If current field is SST
+                 IF(cfilmet(ig_number_field(jf))(4:6) .EQ. 'SST') THEN
+                    CALL parse(clline, clvari, 4, jpeighty, ilen)
+!     * Get flag for coast mismatch correction
+                    READ(clvari,FMT = 2005) nfcoast
+                    IF (cfilmet(ig_number_field(jf))(1:3) .EQ. 'SMO') &
+                        THEN
+                        CALL parse(clline, clvari, 5, jpeighty, ilen)
+!     * Get field name for flux corrective term 
+                        cfldcor = clvari
+                        CALL parse(clline, clvari, 6, jpeighty, ilen)
+!     * Get logical unit used to write flux corrective term
+                        READ(clvari,FMT = 2005) nlucor
+                    ENDIF
+                 ENDIF 
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV')  &
+                      THEN            
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get conservation method
+                 cconmet(ig_number_field(jf)) = clvari
+                 lsurf(ig_number_field(jf)) = .TRUE.
+                 CALL parse(clline, clvari, 2, jpeighty, ilen)
+                 cconopt(ig_number_field(jf)) = 'bfb'
+                 if (ilen > 0) then
+                    if (trim(clvari) == 'bfb' .or. trim(clvari) == 'opt') then
+                       cconopt(ig_number_field(jf)) = clvari
+                    else
+                       call prtout ('ERROR in namcouple conserv argument',jf,1)
+                       IF (mpi_rank_global == 0) THEN
+                           WRITE(nulprt1,*) 'ERROR in namcouple conserv argument ',&
+                                             TRIM(clvari)
+                           WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                           WRITE (nulprt1,'(a)') ' error = STOP in inipar cconopt'
+                           CALL oasis_flush(nulprt1)
+                       ENDIF
+                       call oasis_abort_noarg()
+                    endif
+                 endif
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD')THEN
+!     * Get linear combination parameters for initial fields
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get main field multiplicative coefficient
+                 READ(clvari,FMT = 2006) afldcobo(ig_number_field(jf))
+                 DO 290 jc = 1, nbofld(ig_number_field(jf))
+                    READ (UNIT = nulin,FMT = 2002) clline   
+                    CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get symbolic names for additional fields
+                    cbofld(jc,ig_number_field(jf)) = clvari
+                    CALL parse(clline, clvari, 2, jpeighty, ilen)
+!     * Get multiplicative coefficients for  additional fields
+                    READ(clvari,FMT = 2006)  &
+                         abocoef (jc,ig_number_field(jf))
+ 290             CONTINUE
+              ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW')THEN
+!     * Get linear combination parameters for final fields
+                 CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get main field multiplicative coefficient
+                 READ(clvari,FMT = 2006) afldcobn(ig_number_field(jf))
+                 DO 291 jc = 1, nbnfld(ig_number_field(jf))
+                    READ (UNIT = nulin,FMT = 2002) clline   
+                    CALL parse(clline, clvari, 1, jpeighty, ilen)
+!     * Get symbolic names for additional fields
+                    cbnfld(jc,ig_number_field(jf)) = clvari
+                    CALL parse(clline, clvari, 2, jpeighty, ilen)
+!     * Get multiplicative coefficients for  additional fields
+                    READ(clvari,FMT = 2006)  &
+                         abncoef (jc,ig_number_field(jf))
+ 291             CONTINUE
+              ELSE 
+                  IF (mpi_rank_global == 0) THEN
+                      WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+                      WRITE (UNIT = nulprt1,FMT = *) &
+                         ' Type of analysis not implemented yet '
+                      WRITE (UNIT = nulprt1,FMT = *)  &
+                         ' The analysis required in OASIS is :'
+                      WRITE (UNIT = nulprt1,FMT = *) ' canal = ',  &
+                         canal(ja,ig_number_field(jf))
+                      WRITE (UNIT = nulprt1,FMT = *)  &
+                         ' with ja = ', ja, ' jf = ', jf
+                      WRITE (UNIT = nulprt1,FMT = *) ' '
+                      WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+                      WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+                      CALL oasis_flush(nulprt1)
+                  ENDIF
+                 CALL oasis_abort_noarg()
+             ENDIF
+ 270       CONTINUE
+          ENDIF
+
+!* End of loop on NoF
+ 
+ 240  CONTINUE
+
+!* Minimum coupling period
+
+      ig_total_frqmin = minval(ig_freq)
+
+!* Formats
+
+ 2001 FORMAT(A9)
+ 2002 FORMAT(A1000)
+ 2003 FORMAT(I4)
+ 2004 FORMAT(I8)
+ 2005 FORMAT(I2)
+ 2006 FORMAT(E15.6)
+ 2008 FORMAT(A2,I4)
+ 2009 FORMAT(A8)
+ 2010 FORMAT(A3,A1,I2)
+ 2011 FORMAT(A3,A1,I8)
+
+!*    3. Printing
+!        --------
+      IF (mpi_rank_global == 0) THEN
+!* Warning: no indentation for the next if (nightmare ...)
+      IF (nlogprt .GE. 0) THEN 
+      DO 310 jf = 1, ig_total_nfield
+         IF (ig_total_state(jf) .eq. ip_exported ) THEN
+            cl_print_state = 'EXPORTED'
+         ELSEIF (ig_total_state(jf) .eq. ip_ignored ) THEN
+            cl_print_state = 'IGNORED'
+         ELSEIF (ig_total_state(jf) .eq. ip_ignout ) THEN
+            cl_print_state = 'IGNOUT'
+         ELSEIF (ig_total_state(jf) .eq. ip_expout ) THEN 
+            cl_print_state = 'EXPOUT'
+         ELSEIF (ig_total_state(jf) .eq. ip_input ) THEN 
+            cl_print_state = 'INPUT'
+         ELSEIF (ig_total_state(jf) .eq. ip_output ) THEN 
+            cl_print_state = 'OUTPUT'
+         ELSEIF (ig_total_state(jf) .eq. ip_auxilary ) THEN 
+            cl_print_state = 'AUXILARY'
+         ENDIF
+         IF (ig_local_trans(jf) .eq. ip_instant) THEN
+            cl_print_trans = 'INSTANT'
+         ELSEIF (ig_local_trans(jf) .eq. ip_average) THEN
+             cl_print_trans = 'AVERAGE'
+         ELSEIF (ig_local_trans(jf) .eq. ip_accumul) THEN
+            cl_print_trans = 'ACCUMUL'
+         ELSEIF (ig_local_trans(jf) .eq. ip_min) THEN
+            cl_print_trans = 'T_MIN'
+         ELSEIF (ig_local_trans(jf) .eq. ip_max) THEN
+            cl_print_trans = 'T_MAX'   
+         ENDIF
+!* Local indexes
+      IF (.NOT. lg_state(jf)) THEN
+         ilab = ig_numlab(jf)
+         WRITE (UNIT = nulprt1,FMT = 3001) jf
+         WRITE (UNIT = nulprt1,FMT = 3002)
+         WRITE (UNIT = nulprt1,FMT = 3003)
+         WRITE (UNIT = nulprt1,FMT = 3004)
+         IF (ig_total_state(jf) .eq. ip_input .or.  &
+              ig_total_state(jf) .eq. ip_output) THEN
+              WRITE (UNIT = nulprt1,FMT = 3121) &
+                    cg_input_field(jf), cg_output_field(jf),  &
+                    ig_freq(jf), cl_print_trans, &
+                    cl_print_state, ig_total_ntrans(jf)
+         ELSE  
+             WRITE (UNIT = nulprt1,FMT = 3116) &
+             cg_input_field(jf), cg_output_field(jf),  &
+             ig_freq(jf), cl_print_trans, ig_total_nseqn(jf),  &
+             ig_lag(jf), cl_print_state, ig_total_ntrans(jf)
+         ENDIF
+      ELSE
+         ilab = numlab(ig_number_field(jf))
+         ifcb = len_trim(cficbf(ig_number_field(jf)))
+         ifca = len_trim(cficaf(ig_number_field(jf)))
+         WRITE (UNIT = nulprt1,FMT = 3001) jf
+         WRITE (UNIT = nulprt1,FMT = 3002)
+         WRITE (UNIT = nulprt1,FMT = 3003)
+         WRITE (UNIT = nulprt1,FMT = 3004) 
+         WRITE (UNIT = nulprt1,FMT = 3005) &
+                    TRIM(cnaminp(ig_number_field(jf))),  &
+                    TRIM(cnamout(ig_number_field(jf))), &
+                    nfexch(ig_number_field(jf)), &
+                    nseqn(ig_number_field(jf)), &
+                    ig_lag(jf), &
+                    cl_print_state, &
+                    ig_ntrans(ig_number_field(jf))
+     ENDIF
+!* Warning: no indentation for the next if (nightmare ...)
+!* Warning: no indentation for the next if (nightmare ...)            
+        IF (.not. lg_state(jf)) THEN
+           IF (ig_total_state(jf) .eq. ip_ignored .or.  &
+               ig_total_state(jf) .eq. ip_ignout ) THEN
+              WRITE (UNIT = nulprt1,FMT = 3117) cg_restart_file(jf)
+           ELSEIF (ig_total_state(jf) .eq. ip_input) THEN
+              WRITE (UNIT = nulprt1,FMT = 3118) cg_input_file(jf)
+           ENDIF
+        ELSE
+           IF (ig_total_state(jf) .eq. ip_exported .or.  &
+                ig_total_state(jf) .eq. ip_expout .or.  &
+                ig_total_state(jf) .eq. ip_auxilary ) &
+                WRITE (UNIT = nulprt1,FMT = 3117) cg_restart_file(jf)
+!* Warning: no indentation for the next if (nightmare ...)           
+        WRITE (UNIT = nulprt1,FMT = 3007) &
+            csper(ig_number_field(jf)), nosper(ig_number_field(jf)),  &
+            ctper(ig_number_field(jf)), notper(ig_number_field(jf))
+        WRITE (UNIT = nulprt1,FMT = 3008) &
+            cficbf(ig_number_field(jf))(1:ifcb)//cglonsuf,  &
+            cficbf(ig_number_field(jf))(1:ifcb)//cglatsuf, &
+            cficbf(ig_number_field(jf))(1:ifcb)//cmsksuf,  &
+            cficbf(ig_number_field(jf))(1:ifcb)//csursuf, &
+            cficaf(ig_number_field(jf))(1:ifca)//cglonsuf,  &
+            cficaf(ig_number_field(jf))(1:ifca)//cglatsuf, &
+            cficaf(ig_number_field(jf))(1:ifca)//cmsksuf,  &
+            cficaf(ig_number_field(jf))(1:ifca)//csursuf
+        WRITE (UNIT = nulprt1,FMT = 3009) 
+        WRITE (UNIT = nulprt1,FMT = 3010)
+        DO 320 ja = 1, ig_ntrans(ig_number_field(jf))
+          WRITE (UNIT = nulprt1,FMT = 3011) ja,  &
+                canal(ja,ig_number_field(jf))
+            IF (canal(ja,ig_number_field(jf)) .EQ. 'MAPPING') THEN
+              write(UNIT = nulprt1,FMT = 3048) &
+                    trim(cmap_file(ig_number_field(jf))), &
+                    trim(cmaptyp(ig_number_field(jf))), &
+                    trim(cmapopt(ig_number_field(jf)))
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'SCRIPR') THEN
+              WRITE(UNIT = nulprt1,FMT = 3045)  &
+                    cmap_method(ig_number_field(jf)),  &
+                    cfldtype(ig_number_field(jf)),  &
+                    cnorm_opt(ig_number_field(jf)), &
+                    crsttype(ig_number_field(jf)),  &
+                    nbins(ig_number_field(jf))
+              IF (cmap_method(ig_number_field(jf)) .EQ. 'CONSERV') THEN 
+                  WRITE(UNIT = nulprt1,FMT = 3046)  &
+                      corder(ig_number_field(jf))
+              ENDIF  
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CONSERV') THEN            
+              WRITE(UNIT = nulprt1,FMT = 3025)  &
+                    cconmet(ig_number_field(jf)),  &
+                    cconopt(ig_number_field(jf))
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASOLD') THEN
+              WRITE(UNIT = nulprt1,FMT = 3027)  &
+                    trim(cnaminp(ig_number_field(jf))),  &
+                    afldcobo(ig_number_field(jf))
+              WRITE(UNIT = nulprt1,FMT=3028) nbofld(ig_number_field(jf))
+              DO 340 jc = 1, nbofld(ig_number_field(jf))
+                WRITE (UNIT = nulprt1,FMT = 3030)  &
+                    cbofld(jc,ig_number_field(jf)),  &
+                      abocoef (jc,ig_number_field(jf))
+ 340          CONTINUE
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'BLASNEW') THEN
+              WRITE(UNIT = nulprt1,FMT = 3027)  &
+                    trim(cnamout(ig_number_field(jf))),  &
+                    afldcobn(ig_number_field(jf))
+              WRITE(UNIT = nulprt1,FMT=3028) nbnfld(ig_number_field(jf))
+              DO 350 jc = 1, nbnfld(ig_number_field(jf))
+                WRITE (UNIT = nulprt1,FMT = 3030)  &
+                    cbnfld(jc,ig_number_field(jf)),  &
+                      abncoef (jc,ig_number_field(jf))
+ 350          CONTINUE
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKIN') THEN
+                WRITE(UNIT = nulprt1,FMT = *) '   '
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'CHECKOUT') THEN
+                WRITE(UNIT = nulprt1,FMT = *) '   '
+            ELSE IF (canal(ja,ig_number_field(jf)) .EQ. 'LOCTRANS') THEN
+               WRITE(UNIT = nulprt1,FMT = 3047) cl_print_trans
+            ELSE 
+              WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+              WRITE (UNIT = nulprt1,FMT = *) &
+                  ' Type of analysis not implemented yet '
+              WRITE (UNIT = nulprt1,FMT = *)  &
+                  ' The analysis required in OASIS is :'
+              WRITE (UNIT = nulprt1,FMT = *) ' canal = ',  &
+                   canal(ja,ig_number_field(jf))
+              WRITE (UNIT = nulprt1,FMT = *)  &
+                  ' with ja = ', ja, ' jf = ', jf
+              WRITE (UNIT = nulprt1,FMT = *) ' '
+              WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+              WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+              CALL oasis_flush(nulprt1)
+              CALL oasis_abort_noarg()
+          ENDIF
+ 320    CONTINUE
+      ENDIF
+ 310  CONTINUE
+     ENDIF
+ENDIF
+
+!* Formats
+
+ 3001 FORMAT(//,15X,'  FIELD NUMBER ',I3)
+ 3002 FORMAT(15X,'  ************  ')
+ 3003 FORMAT(/,10X,'  Field parameters ')
+ 3004 FORMAT(10X,'  ****************  ',/)
+ 3005 FORMAT(/,10X,'  Input field symbolic name       = ',A, &
+             /,10X,'  Output field symbolic name      = ',A, &
+             /,10X,'  Field exchange frequency        = ',I8, &
+             /,10X,'  Model sequential index          = ',I2, &
+             /,10X,'  Field Lag                       = ',I8, &
+             /,10X,'  Field I/O status                = ',A8, &
+             /,10X,'  Number of basic operations      = ',I4, /)
+ 3116 FORMAT(/,10X,'  Input field symbolic name       = ',A8, &
+             /,10X,'  Output field symbolic name      = ',A8, &
+             /,10X,'  Field exchange frequency        = ',I8, &
+             /,10X,'  Local transformation            = ',A8, &
+             /,10X,'  Model sequential index          = ',I2, &
+             /,10X,'  Field Lag                       = ',I8,  &
+             /,10X,'  Field I/O status                = ',A8, &
+             /,10X,'  Number of basic operations      = ',I4,/)
+ 3117 FORMAT(/,10X,'  Restart file name               = ',A8,/)
+ 3118 FORMAT(/,10X,'  Input file name                 = ',A32,/)
+ 3121 FORMAT(/,10X,'  Input field symbolic name       = ',A8, &
+             /,10X,'  Output field symbolic name      = ',A8, &
+             /,10X,'  Field exchange frequency        = ',I8, &
+             /,10X,'  Local transformation            = ',A8, &
+             /,10X,'  Field I/O status                = ',A8, &
+             /,10X,'  Number of basic operations      = ',I4,/)
+ 3007 FORMAT( &
+             /,10X,'  Source grid periodicity type is      = ',A8, &
+             /,10X,'  Number of overlapped grid points is  = ',I2, &
+             /,10X,'  Target grid periodicity type is      = ',A8, &
+             /,10X,'  Number of overlapped grid points is  = ',I2,/)
+ 3008 FORMAT(/,10X,'  Source longitude file string    = ',A8, &
+             /,10X,'  Source latitude file string     = ',A8, &
+             /,10X,'  Source mask file string         = ',A8, &
+             /,10X,'  Source surface file string      = ',A8, &
+             /,10X,'  Target longitude file string    = ',A8, &
+             /,10X,'  Target latitude file string     = ',A8, &
+             /,10X,'  Target mask file string         = ',A8, &
+             /,10X,'  Target surface file string      = ',A8,/)
+ 3009 FORMAT(/,10X,'  ANALYSIS PARAMETERS ')
+ 3010 FORMAT(10X,'  ******************* ',/)
+ 3011 FORMAT(/,5X,'  ANALYSIS number ',I2,' is ',A8, &
+             /,5X,'  ***************  ',/)
+ 3025 FORMAT(5X,' Conservation method for field is  = ',A8, &
+           /,5X,' Conservation option is            = ',A8)
+ 3027 FORMAT(5X,' Field ',A,' is multiplied by Cst = ',E15.6)
+ 3028 FORMAT(5X,' It is combined with N fields    N = ',I2)
+ 3030 FORMAT(5X,'   With field ',A8,'   coefficient = ',E15.6)
+ 3043 FORMAT(/,5X,'No lag in namcouple for the field', I3, &
+          /,5X,' Default value LAG=0 will be used ')
+ 3044 FORMAT(/,5X,'The lag for the field ',I3,3X,'is : ',I8)
+ 3045 FORMAT(5X,' Remapping method is               = ',A8, &
+           /,5X,' Field type is                     = ',A8, &
+           /,5X,' Normalization option is           = ',A8, &
+           /,5X,' Seach restriction type is         = ',A8, &
+           /,5X,' Number of search bins is          = ',I4)
+ 3046 FORMAT(5X,' Order of remapping is             = ',A8)
+ 3047 FORMAT(5X,' Local transformation  = ',A8) 
+ 3048 FORMAT(5X,' Remapping filename is             = ',A, &
+           /,5X,' Mapping location is               = ',A8, &
+           /,5X,' Mapping optimization is           = ',A8)
+
+
+!*    4. End of routine
+!        --------------
+
+   IF (mpi_rank_global == 0) THEN
+       IF (nlogprt .GE. 0) THEN
+           WRITE(UNIT = nulprt1,FMT = *)' '
+           WRITE(UNIT = nulprt1,FMT = *)'------ End of ROUTINE inipar ----'
+           CALL oasis_flush (nulprt1)
+       ENDIF
+   ENDIF
+!      call oasis_debug_exit(subname)
+      RETURN
+
+!* Error branch output
+
+ 130  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *) &
+             ' No active $NBMODEL data found in input file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+
+ 191  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *) &
+             ' Problem with $RUNTIME in input file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+ 199  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *) &
+             ' No active $NLOGPRT found in input file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+ 210  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' No active $FIELDS data found in input file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+ 230  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' No active $STRING data found in input file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+ 233  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+      ENDIF
+      CALL prtout ('ERROR in namcouple for field', jf, 1)
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'Check the 2nd line for either the index of sequential position, &
+              & the delay flag, or the extra timestep flag.'
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+ 235  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+      ENDIF
+      CALL prtout ('ERROR in namcouple for field', jf, 1)
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'An input line with integral calculation flag' 
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             '("INT=0" or "INT=1")'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'is now required for analysis CHECKIN or CHECKOUT'
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg() 
+ 236  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+      ENDIF
+      CALL prtout ('ERROR in namcouple for field', jf, 1)
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'The coupling period must not be 0 !'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'If you do not want to exchange this field at all'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             'give a coupling period longer than the total run time.'
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar.f'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg() 
+
+      END SUBROUTINE inipar
+!===============================================================================
+ 
+  SUBROUTINE alloc()
+
+  IMPLICIT NONE
+
+  character(len=*),parameter :: subname='mod_oasis_namcouple:alloc'
+
+!  call oasis_debug_enter(subname)
+
+  !--- alloc_anais1
+  ALLOCATE (varmul(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "varmul"allocation of anais module',il_err,1)
+  varmul(:)=0
+  ALLOCATE (niwtm(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtm"allocation of anais module',il_err,1)
+  niwtm(:)=0
+  ALLOCATE (niwtg(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtg"allocation of anais module',il_err,1)
+  niwtg(:)=0
+  allocate (linit(ig_nfield), stat=il_err)
+  if (il_err.ne.0) call prtout('error in "linit"allocation of anais module',il_err,1)
+  linit(:)=.false.
+
+  !--- alloc_analysis
+  ALLOCATE (ncofld(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ncofld"allocation of analysis module',il_err,1)
+  ncofld(:)=0
+  ALLOCATE (neighborg(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "neighborg"allocation of analysis module',il_err,1)
+  neighborg(:)=0
+  ALLOCATE (nludat(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nludat"allocation of analysis module',il_err,1)
+  nludat(:,:)=0
+  ALLOCATE (nlufil(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlufil"allocation of analysis module',il_err,1)
+  nlufil(:)=0
+  ALLOCATE (nlumap(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlumap"allocation of analysis module',il_err,1)
+  nlumap(:)=0
+  ALLOCATE (nlusub(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlusub"allocation of analysis module',il_err,1)
+  nlusub(:)=0
+  ALLOCATE (nluext(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nluext"allocation of analysis module',il_err,1)
+  nluext(:)=0
+  ALLOCATE (nosper(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nosper"allocation of analysis module',il_err,1)
+  nosper(:)=0
+  ALLOCATE (notper(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "notper"allocation of analysis module',il_err,1)
+  notper(:)=0
+  ALLOCATE (amskval(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "amskval"allocation of analysis module',il_err,1)
+  amskval(:)=0
+  ALLOCATE (amskvalnew(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "amskvalnew"allocation of analysis module',il_err,1)
+  amskvalnew(:)=0
+  ALLOCATE (acocoef(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "acocoef"allocation of analysis module',il_err,1)
+  acocoef(:,:)=0
+  ALLOCATE (abocoef(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "abocoef"allocation of analysis module',il_err,1)
+  abocoef(:,:)=0
+  ALLOCATE (abncoef(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "abncoef"allocation of analysis module',il_err,1)
+  abncoef(:,:)=0
+  ALLOCATE (afldcoef(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcoef"allocation of analysis module',il_err,1)
+  afldcoef(:)=0
+  ALLOCATE (afldcobo(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcobo"allocation of analysis module',il_err,1)
+  afldcobo(:)=0
+  ALLOCATE (afldcobn(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcobn"allocation of analysis module',il_err,1)
+  afldcobn(:)=0
+  ALLOCATE (cxordbf(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cxordbf"allocation of analysis module',il_err,1)
+  cxordbf(:)=' '
+  ALLOCATE (cyordbf(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cyordbf"allocation of analysis module',il_err,1)
+  cyordbf(:)=' '
+  ALLOCATE (cxordaf(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cxordaf"allocation of analysis module',il_err,1)
+  cxordaf(:)=' '
+  ALLOCATE (cyordaf(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cyordaf"allocation of analysis module',il_err,1)
+  cyordaf(:)=' '
+  ALLOCATE (cgrdtyp(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdtyp"allocation of analysis module',il_err,1)
+  cgrdtyp(:)=' '
+  ALLOCATE (cfldtyp(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldtyp"allocation of analysis module',il_err,1)
+  cfldtyp(:)=' '
+  ALLOCATE (cfilfic(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfilfic"allocation of analysis module',il_err,1)
+  cfilfic(:)=' '
+  ALLOCATE (cfilmet(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfilmet"allocation of analysis module',il_err,1)
+  cfilmet(:)=' '
+  ALLOCATE (cconmet(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cconmet"allocation of analysis module',il_err,1)
+  cconmet(:)=' '
+  ALLOCATE (cconopt(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cconopt"allocation of analysis module',il_err,1)
+  cconopt(:)=' '
+  ALLOCATE (cfldcoa(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldcoa"allocation of analysis module',il_err,1)
+  cfldcoa(:)=' '
+  ALLOCATE (cfldfin(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldfin"allocation of analysis module',il_err,1)
+  cfldfin(:)=' '
+  ALLOCATE (ccofld(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ccofld"allocation of analysis module',il_err,1)
+  ccofld(:,:)=' '
+  ALLOCATE (cbofld(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cbofld"allocation of analysis module',il_err,1)
+  cbofld(:,:)=' '
+  ALLOCATE (cbnfld(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cbnfld"allocation of analysis module',il_err,1)
+  cbnfld(:,:)=' '
+  ALLOCATE (ccofic(ig_maxcomb,ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ccofic"allocation of analysis module',il_err,1)
+  ccofic(:,:)=' '
+  ALLOCATE (cdqdt(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cdqdt"allocation of analysis module',il_err,1)
+  cdqdt(:)=' '
+  ALLOCATE (cgrdmap(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdmap"allocation of analysis module',il_err,1)
+  cgrdmap(:)=' '
+  ALLOCATE (cmskrd(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmskrd"allocation of analysis module',il_err,1)
+  cmskrd(:)=' '
+  ALLOCATE (cgrdsub(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdsub"allocation of analysis module',il_err,1)
+  cgrdsub(:)=' '
+  ALLOCATE (ctypsub(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ctypsub"allocation of analysis module',il_err,1)
+  ctypsub(:)=' '
+  ALLOCATE (cgrdext(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdext"allocation of analysis module',il_err,1)
+  cgrdext(:)=' '
+  ALLOCATE (csper(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "csper"allocation of analysis module',il_err,1)
+  csper(:)=' '
+  ALLOCATE (ctper(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ctper"allocation of analysis module',il_err,1)
+  ctper(:)=' '
+  ALLOCATE (lsurf(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lsurf"allocation of analysis module',il_err,1)
+  lsurf(:)=.false.
+  ALLOCATE (nscripvoi(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in nscripvoi allocation of analysis module',il_err,1)
+  nscripvoi(:)=0
+! 
+!* Alloc array needed for SCRIP 
+!
+  ALLOCATE (cmap_method(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmap_method" allocation of inipar_alloc',il_err,1)
+  cmap_method(:)=' '
+  ALLOCATE (cmap_file(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmap_file" allocation of inipar_alloc',il_err,1)
+  cmap_file(:)=' '
+  ALLOCATE (cmaptyp(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmaptyp" allocation of inipar_alloc',il_err,1)
+  cmaptyp(:)=' '
+  ALLOCATE (cmapopt(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmapopt" allocation of inipar_alloc',il_err,1)
+  cmapopt(:)=' '
+  ALLOCATE (cfldtype(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldtype"allocation of inipar_alloc',il_err,1)
+  cfldtype(:)=' '
+  ALLOCATE (crsttype(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "crsttype"allocation of inipar_alloc',il_err,1)
+  crsttype(:)=' '
+  ALLOCATE (nbins(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nbins"allocation of inipar_alloc',il_err,1)
+  nbins(:)=0
+  ALLOCATE (cnorm_opt(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnorm_opt"allocation of inipar_alloc',il_err,1)
+  cnorm_opt(:)=' '
+  ALLOCATE (corder(ig_nfield),stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "corder"allocation of inipar_alloc',il_err,1)
+  corder(:)=' '
+!
+  !--- alloc_extrapol1
+  ALLOCATE (niwtn(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtn"allocation of extrapol module',il_err,1)
+  niwtn(:)=0
+  ALLOCATE (niwtng(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtng"allocation of extrapol module',il_err,1)
+  niwtng(:)=0
+  ALLOCATE (lextra(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lextra"allocation of extrapol module',il_err,1)
+  lextra(:)=.false.
+  ALLOCATE (lweight(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lweight"allocation of extrapol module',il_err,1)
+  lweight(:)=.false.
+
+  !--- alloc_rainbow1
+  ALLOCATE (lmapp(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lmapp"allocation of rainbow module',il_err,1)
+  lmapp(:)=.false.
+  ALLOCATE (lsubg(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lsubg"allocation of rainbow module',il_err,1)
+  lsubg(:)=.false.
+
+  !--- alloc_string
+  ALLOCATE (cg_name_rstfile(ig_nbr_rstfile), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cg_name_rstfile"allocation of string module',il_err,1)
+  cg_name_rstfile(:)=' '
+  ALLOCATE (ig_lag(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_lag"allocation of string module',il_err,1) 
+  ig_lag(:)=0
+  ALLOCATE (ig_no_rstfile(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_no_rstfile"allocation of string module',il_err,1)
+  ig_no_rstfile(:)=1
+  ALLOCATE (cg_input_field(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cg_input_field"allocation of string module',il_err,1)
+  cg_input_field(:)=' '
+  ALLOCATE (ig_numlab(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_numlab"allocation of string module',il_err,1)
+  ig_numlab(:)=0
+  ALLOCATE (ig_freq(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_freq"allocation of string module',il_err,1)
+  ig_freq(:)=0
+  ALLOCATE (ig_total_nseqn(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_total_nseqn"allocation of string module',il_err,1)
+  ig_total_nseqn(:)=0
+  ALLOCATE (ig_local_trans(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_local_trans"allocation of string module',il_err,1)
+  ig_local_trans(:)=0
+  ALLOCATE (ig_invert(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_invert" allocation of string module',il_err,1) 
+  ig_invert(:)=0
+  ALLOCATE (ig_reverse(ig_total_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_reverse" allocation of string module',il_err,1) 
+  ig_reverse(:)=0
+!
+!** + Allocate following arrays only if one field (at least) goes
+!     through Oasis
+!
+  IF (lg_oasis_field) THEN
+  ALLOCATE (numlab(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "numlab"allocation of string module',il_err,1)
+  numlab(:)=0
+  ALLOCATE (nfexch(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nfexch"allocation of string module',il_err,1)
+  nfexch(:)=0
+  ALLOCATE (nseqn(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nseqn"allocation of string module',il_err,1)
+  nseqn(:)=0
+  ALLOCATE (nlagn(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlagn" allocation of string module',il_err,1)
+  nlagn(:)=0
+  ALLOCATE (cnaminp(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnaminp"allocation of string module',il_err,1)
+  cnaminp(:)=' '
+  ALLOCATE (cnamout(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnamout"allocation of string module',il_err,1)
+  cnamout(:)=' '
+  ALLOCATE (cficout(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cficout"allocation of string module',il_err,1)
+  cficout(:)=' '
+  ALLOCATE (cstate(ig_nfield), stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cstate"allocation of string module',il_err,1)
+  cstate(:)=' '
+  ENDIF
+
+!  call oasis_debug_exit(subname)
+
+  END SUBROUTINE alloc
+!===============================================================================
+  SUBROUTINE dealloc
+
+  IMPLICIT NONE
+
+  character(len=*),parameter :: subname='mod_oasis_namcouple:dealloc'
+
+  !--- alloc_anais1
+  DEALLOCATE (varmul, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "varmul"deallocation of anais module',il_err,1)
+  DEALLOCATE (niwtm, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtm"deallocation of anais module',il_err,1)
+  DEALLOCATE (niwtg, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtg"deallocation of anais module',il_err,1)
+  deallocate (linit, stat=il_err)
+  if (il_err.ne.0) call prtout('error in "linit"deallocation of anais module',il_err,1)
+
+  !--- alloc_analysis
+  DEALLOCATE (ncofld, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ncofld"deallocation of analysis module',il_err,1)
+  DEALLOCATE (neighborg, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "neighborg"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nludat, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nludat"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nlufil, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlufil"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nlumap, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlumap"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nlusub, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlusub"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nluext, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nluext"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nosper, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nosper"deallocation of analysis module',il_err,1)
+  DEALLOCATE (notper, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "notper"deallocation of analysis module',il_err,1)
+  DEALLOCATE (amskval, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "amskval"deallocation of analysis module',il_err,1)
+  DEALLOCATE (amskvalnew, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "amskvalnew"deallocation of analysis module',il_err,1)
+  DEALLOCATE (acocoef, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "acocoef"deallocation of analysis module',il_err,1)
+  DEALLOCATE (abocoef, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "abocoef"deallocation of analysis module',il_err,1)
+  DEALLOCATE (abncoef, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "abncoef"deallocation of analysis module',il_err,1)
+  DEALLOCATE (afldcoef, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcoef"deallocation of analysis module',il_err,1)
+  DEALLOCATE (afldcobo, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcobo"deallocation of analysis module',il_err,1)
+  DEALLOCATE (afldcobn, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "afldcobn"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cxordbf, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cxordbf"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cyordbf, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cyordbf"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cxordaf, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cxordaf"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cyordaf, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cyordaf"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cgrdtyp, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdtyp"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cfldtyp, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldtyp"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cfilfic, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfilfic"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cfilmet, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfilmet"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cconmet, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cconmet"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cconopt, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cconopt"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cfldcoa, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldcoa"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cfldfin, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldfin"deallocation of analysis module',il_err,1)
+  DEALLOCATE (ccofld, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ccofld"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cbofld, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cbofld"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cbnfld, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cbnfld"deallocation of analysis module',il_err,1)
+  DEALLOCATE (ccofic, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ccofic"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cdqdt, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cdqdt"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cgrdmap, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdmap"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cmskrd, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmskrd"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cgrdsub, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdsub"deallocation of analysis module',il_err,1)
+  DEALLOCATE (ctypsub, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ctypsub"deallocation of analysis module',il_err,1)
+  DEALLOCATE (cgrdext, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cgrdext"deallocation of analysis module',il_err,1)
+  DEALLOCATE (csper, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "csper"deallocation of analysis module',il_err,1)
+  DEALLOCATE (ctper, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ctper"deallocation of analysis module',il_err,1)
+  DEALLOCATE (lsurf, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lsurf"deallocation of analysis module',il_err,1)
+  DEALLOCATE (nscripvoi, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in nscripvoi deallocation of analysis module',il_err,1)
+! 
+!* Alloc array needed for SCRIP 
+!
+  DEALLOCATE (cmap_method,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmap_method" deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (cmap_file,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmap_file" deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (cmaptyp,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmaptyp" deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (cmapopt,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cmapopt" deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (cfldtype,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cfldtype"deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (crsttype,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "crsttype"deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (nbins,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nbins"deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (cnorm_opt,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnorm_opt"deallocation of inipar_alloc',il_err,1)
+  DEALLOCATE (corder,stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "corder"deallocation of inipar_alloc',il_err,1)
+  !
+  !--- alloc_extrapol1
+  DEALLOCATE (niwtn, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtn"deallocation of extrapol module',il_err,1)
+  DEALLOCATE (niwtng, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "niwtng"deallocation of extrapol module',il_err,1)
+  DEALLOCATE (lextra, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lextra"deallocation of extrapol module',il_err,1)
+  DEALLOCATE (lweight, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lweight"deallocation of extrapol module',il_err,1)
+
+  !--- alloc_rainbow1
+  DEALLOCATE (lmapp, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lmapp"deallocation of rainbow module',il_err,1)
+  DEALLOCATE (lsubg, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "lsubg"deallocation of rainbow module',il_err,1)
+
+  !--- alloc_string
+  DEALLOCATE (cg_name_rstfile, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cg_name_rstfile"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_lag, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_lag"deallocation of string module',il_err,1) 
+  DEALLOCATE (ig_no_rstfile, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_no_rstfile"deallocation of string module',il_err,1)
+  DEALLOCATE (cg_input_field, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cg_input_field"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_numlab, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_numlab"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_freq, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_freq"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_total_nseqn, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_total_nseqn"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_local_trans, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_local_trans"deallocation of string module',il_err,1)
+  DEALLOCATE (ig_invert, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_invert" deallocation of string module',il_err,1) 
+  DEALLOCATE (ig_reverse, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "ig_reverse" deallocation of string module',il_err,1) 
+!
+!** + Deallocate following arrays only if one field (at least) goes
+!     through Oasis
+!
+  IF (lg_oasis_field) THEN
+  DEALLOCATE (numlab, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "numlab"deallocation of string module',il_err,1)
+  DEALLOCATE (nfexch, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nfexch"deallocation of string module',il_err,1)
+  DEALLOCATE (nseqn, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nseqn"deallocation of string module',il_err,1)
+  DEALLOCATE (nlagn, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "nlagn" deallocation of string module',il_err,1)
+  DEALLOCATE (cnaminp, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnaminp"deallocation of string module',il_err,1)
+  DEALLOCATE (cnamout, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cnamout"deallocation of string module',il_err,1)
+  DEALLOCATE (cficout, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cficout"deallocation of string module',il_err,1)
+  DEALLOCATE (cstate, stat=il_err)
+  IF (il_err.NE.0) CALL prtout ('Error in "cstate"deallocation of string module',il_err,1)
+  ENDIF
+
+!  call oasis_debug_exit(subname)
+
+  END SUBROUTINE dealloc
+!===============================================================================
+
+  SUBROUTINE prtout(cdtext, kvalue, kstyle)
+
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL 1 *
+!               * -------------     ------- *
+!               *****************************
+!
+!**** *prtout*  - Print output
+!
+!     Purpose:
+!     -------
+!     Print out character string and one integer value
+!
+!**   Interface:
+!     ---------
+!       *CALL*  *prtout (cdtext, kvalue, kstyle)*
+!
+!     Input:
+!     -----
+!                cdtext : character string to be printed
+!                kvalue : integer variable to be printed
+!                kstyle : printing style
+!
+!     Output:
+!     ------
+!     None
+!
+!     Workspace:
+!     ---------
+!
+!     Externals:
+!     ---------
+!     None
+!
+!     Reference:
+!     ---------
+!     See OASIS manual (1995) 
+!
+!     History:
+!     -------
+!       Version   Programmer     Date      Description
+!       -------   ----------     ----      -----------  
+!       2.0       L. Terray      95/10/01  created
+!       2.3       L. Terray      99/02/24  modified: X format for NEC
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+      IMPLICIT NONE
+!
+!* ---------------------------- Include files ---------------------------
+!
+!
+!* ---------------------------- Argument declarations ----------------------
+!
+      CHARACTER(len=*),intent(in) :: cdtext
+      INTEGER (kind=ip_intwp_p),intent(in) :: kvalue, kstyle
+
+!* ---------------------------- Local declarations ----------------------
+
+      integer(kind=ip_intwp_p) :: ilen,jl
+      CHARACTER*69 cline
+      character(len=*),PARAMETER :: cbase = '-'
+      character(len=*),PARAMETER :: cprpt = '* ===>>> :'
+      character(len=*),PARAMETER :: cdots = '  ------  '
+      character(len=*),parameter :: subname='mod_oasis_namcouple:prtout'
+
+!* ---------------------------- Poema verses ----------------------------
+
+!  call oasis_debug_enter(subname)
+
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+!*    1. Print character string + integer value
+!        --------------------------------------
+
+  IF (mpi_rank_global == 0) THEN
+      IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2) THEN
+          cline = ' '
+          ilen = len(cdtext)
+          DO 110 jl = 1, ILEN
+            cline(jl:jl) = cbase
+ 110      CONTINUE
+          
+          IF ( kstyle .EQ. 2 ) THEN
+              WRITE(UNIT = nulprt1,FMT='(/,A,1X,A)') cdots, cline
+          ENDIF
+          WRITE(UNIT = nulprt1,FMT='(A,1X,A,1X,I18)') cprpt, cdtext, kvalue
+          WRITE(UNIT = nulprt1,FMT='(A,1X,A,/)') cdots, cline
+        ELSE
+          WRITE(UNIT = nulprt1,FMT='(/,A,1X,A,1X,I18,/)') cprpt, cdtext, kvalue
+      ENDIF
+
+!*    2. End of routine
+!        --------------
+
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+!      call oasis_debug_exit(subname)
+
+  END SUBROUTINE prtout
+
+!===============================================================================
+
+      SUBROUTINE prcout (cdtext, cdstring, kstyle)
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL 1 *
+!               * -------------     ------- *
+!               *****************************
+!
+!**** *prcout*  - Print output
+!
+!     Purpose:
+!     -------
+!     Print out character string and one character value
+!
+!**   Interface:
+!     ---------
+!       *CALL*  *prcout (cdtext, cdstring, kstyle)*
+!
+!     Input:
+!     -----
+!                cdtext   : character string to be printed
+!                cdstring : character variable to be printed
+!                kstyle   : printing style
+!
+!     Output:
+!     ------
+!     None
+!
+!     Workspace:
+!     ---------
+!     None
+!
+!     Externals:
+!     ---------
+!     None
+!
+!     Reference:
+!     ---------
+!     See OASIS manual (1995) 
+!
+!     History:
+!     -------
+!       Version   Programmer     Date      Description
+!       -------   ----------     ----      -----------  
+!       2.0       L. Terray      95/10/01  created
+!       2.3       L. Terray      99/02/24  modified: X format for NEC
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+      IMPLICIT NONE
+!
+!* ---------------------------- Include files ---------------------------
+!
+!
+!* ---------------------------- Argument declarations ----------------------
+!
+      CHARACTER(len=*),intent(in) :: cdtext, cdstring
+      INTEGER (kind=ip_intwp_p),intent(in) :: kstyle
+!
+!* ---------------------------- Local declarations ----------------------
+!
+      integer (kind=ip_intwp_p) :: ilen,jl
+      CHARACTER*69 cline
+      character(len=*), PARAMETER :: cpbase = '-'
+      character(len=*), PARAMETER :: cprpt = '* ===>>> :'
+      character(len=*), PARAMETER :: cpdots = '  ------  ' 
+      character(len=*),parameter :: subname='mod_oasis_namcouple:prcout'
+!
+!* ---------------------------- Poema verses ----------------------------
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+!*    1. Print character string + character value
+!        ----------------------------------------
+!
+!  call oasis_debug_enter(subname)
+
+   IF (mpi_rank_global == 0) THEN
+      IF ( kstyle .EQ. 1 .OR. kstyle .EQ. 2) THEN
+          cline = ' '
+          ilen = len(cdtext)
+          DO 110 jl = 1, ilen
+            cline(jl:jl) = cpbase
+ 110      CONTINUE
+          IF ( kstyle .EQ. 2 ) THEN
+              WRITE(UNIT = nulprt1,FMT='(/,A,1X,A)') cpdots, cline
+          ENDIF
+          WRITE(UNIT = nulprt1,FMT='(A,1X,A,1X,A)') cprpt, cdtext, cdstring
+          WRITE(UNIT = nulprt1,FMT='(A,1X,A,/)') cpdots, cline
+        ELSE
+          WRITE(UNIT = nulprt1,FMT='(/,A,1X,A,1X,A,/)') cprpt, cdtext, cdstring
+      ENDIF
+!
+!
+!*    3. End of routine
+!        --------------
+!
+      CALL oasis_flush(nulprt1)
+  ENDIF
+
+!      call oasis_debug_exit(subname)
+
+      END SUBROUTINE prcout
+!===============================================================================
+
+  SUBROUTINE parse (cdone, cdtwo, knumb, klen, kleng)
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL T *
+!               * -------------     ------- *
+!               *****************************
+!
+!**** *parse*  - Parsing routine
+!
+!     Purpose:
+!     -------
+!     Find the knumb'th string in cdone and put it in cdtwo.
+!     A string is defined as a continuous set of non-blanks characters
+!
+!**   Interface:
+!     ---------
+!       *CALL*  *parse (cdone, cdtwo, knumb, klen, kleng)*
+!
+!     Input:
+!     -----
+!                cdone : line to be parsed (char string)
+!                knumb : rank within the line of the extracted string (integer)
+!                klen  : length of the input line (integer)
+!
+!     Output:
+!     ------
+!                cdtwo : extracted character string (char string)
+!                kleng : length of the extracted string (integer)
+!
+!     Workspace:
+!     ---------
+!     None
+!
+!     Externals:
+!     ---------
+!
+!     Reference:
+!     ---------
+!     See OASIS manual (1995)
+!
+!     History:
+!     -------
+!       Version   Programmer     Date      Description
+!       -------   ----------     ----      -----------  
+!       2.0       L. Terray      95/09/01  created
+!                 O. Marti     2000/11/08  simplify by using F90 
+!                                          CHARACTER functions
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+      IMPLICIT NONE
+!
+!* ---------------------------- Include files ---------------------------
+!
+!
+!* ---------------------------- Argument declarations -------------------
+!
+  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen
+  CHARACTER (len=klen), INTENT ( inout) :: cdone 
+  CHARACTER (len=klen), INTENT ( out) :: cdtwo
+  INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng
+!
+!* ---------------------------- Local declarations -------------------
+!
+  integer(kind=ip_intwp_p) :: ii,jl
+  CHARACTER (len=klen) :: clline
+  CHARACTER (len=klen) :: clwork
+  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
+  character(len=*),parameter :: subname='mod_oasis_namcouple:parse'
+!
+!* ---------------------------- Poema verses ----------------------------
+
+!  call oasis_debug_enter(subname)
+
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+!*    1. Skip line if it is a comment
+!        ----------------------------
+!
+100 IF (cdone(1:1) .NE. clcmt) GO TO 120
+  READ (UNIT = nulin, FMT = 1001, END=241) clline 
+  cdone(1:klen) = clline(1:klen)
+  GO TO 100
+120 CONTINUE 
+1001 FORMAT(A1000)
+!
+!
+!*    2. Do the extraction job
+!        ---------------------
+!
+!* - Fill cdtwo with blanks
+!
+  cdtwo = clblank
+!
+!* Fill temporary string and remove leading blanks
+!
+  clwork = ADJUSTL ( cdone)
+!
+!* - If there are no more characters, kleng=-1
+!
+  IF ( LEN_TRIM ( clwork) .LE. 0) THEN
+      kleng = -1
+!      call oasis_debug_exit(subname)
+      RETURN
+  END IF
+!
+!* - If this is the one we're looking for, skip
+!    otherwise go knumb-1 more sets of characters
+!
+  IF (knumb .GE. 2) THEN
+      DO jl = 1, knumb-1
+        ii = INDEX ( clwork, clblank) - 1
+        clwork ( 1:ii) = clblank
+        clwork = ADJUSTL ( clwork)
+!
+!* - If there are no more characters, kleng=-1
+!
+        IF (LEN_TRIM ( clwork) .LE. 0) THEN
+            kleng = -1
+!            call oasis_debug_exit(subname)
+            RETURN
+        END IF
+      END DO
+  END IF
+!
+!* - Find the length of this set of characters
+!
+  kleng = INDEX ( clwork, clblank) - 1
+!
+!* - Copy to cdtwo
+!
+  cdtwo ( 1:kleng) = clwork ( 1: kleng)
+!
+!*    3. End of routine
+!        --------------
+!
+!  call oasis_debug_exit(subname)
+
+  return
+
+ 241  CONTINUE
+      IF (mpi_rank_global == 0) THEN
+          WRITE (UNIT = nulprt1,FMT = *) '        ***WARNING***'
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' NFIELDS larger or smaller than the number of inputs in namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (UNIT = nulprt1,FMT = *)  &
+             ' We STOP!!! Check the file namcouple'
+          WRITE (UNIT = nulprt1,FMT = *) ' '
+          WRITE (nulprt1,'(a,i4)') ' abort by model ',compid
+          WRITE (nulprt1,'(a)') ' error = STOP in inipar_alloc'
+          CALL oasis_flush(nulprt1)
+      ENDIF
+      CALL oasis_abort_noarg()
+
+
+  END SUBROUTINE parse
+
+!===============================================================================
+
+  SUBROUTINE parseblk (cdone, cdtwo, knumb, klen, kleng)
+
+!****
+!               *****************************
+!               * OASIS ROUTINE  -  LEVEL T *
+!               * -------------     ------- *
+!               *****************************
+!
+!**** *parse*  - Parsing routine
+!
+!     Purpose:
+!     -------
+!     Get the rest of the line starting at the knumb'th string.
+!     A string is defined as a continuous set of non-blanks characters
+!
+!**   Interface:
+!     ---------
+!       *CALL*  *parseblk (cdone, cdtwo, knumb, klen, kleng)*
+!
+!     Input:
+!     -----
+!                cdone : line to be parsed (char string)
+!                knumb : rank within the line of the starting string (integer)
+!                klen  : length of the input line (integer)
+!
+!     Output:
+!     ------
+!                cdtwo : extracted rest of line, including blanks (char string)
+!                kleng : length of the extracted string (integer)
+!
+!     Workspace:
+!     ---------
+!     None
+!
+!     Externals:
+!     ---------
+!
+!     History:
+!     -------
+!       Version   Programmer     Date      Description
+!       -------   ----------     ----      -----------  
+!       2.5       S. Valcke      00/09/08  Adapted from parse.f
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+  IMPLICIT NONE
+!
+!* ---------------------------- Include files ---------------------------
+!
+!
+!* ---------------------------- Argument declarations -------------------
+!
+  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen
+  CHARACTER (len=klen), INTENT ( inout) :: cdone
+  CHARACTER (len=klen), INTENT ( out) :: cdtwo
+  INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng
+!
+!* ---------------------------- Local declarations -------------------
+!
+  INTEGER (kind=ip_intwp_p) :: ii,jl
+  INTEGER (kind=ip_intwp_p) :: il, kleng_aux
+  CHARACTER (len=klen) :: clline
+  CHARACTER (len=klen) :: clwork
+  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
+  character(len=*),parameter :: subname='mod_oasis_namcouple:parseblk'
+!
+!* ---------------------------- Poema verses ----------------------------
+
+!  call oasis_debug_enter(subname)
+
+!
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+!*    1. Skip line if it is a comment
+!        ----------------------------
+!
+100 IF (cdone(1:1) .NE. clcmt) GO TO 120
+  READ (UNIT = nulin, FMT = 1001) clline 
+  cdone(1:klen) = clline(1:klen)
+  GO TO 100
+120 CONTINUE 
+1001 FORMAT(A1000)
+!
+!
+!*    2. Do the extraction job
+!        ---------------------
+!
+!* - Fill cdtwo with blanks
+!
+  cdtwo = clblank
+!
+!* Fill temporary string and remove leading blanks
+!
+  il = INDEX ( cdone, clblank)
+  kleng_aux = 1
+  IF (INDEX ( cdone, clblank).EQ.1) THEN
+      DO WHILE (cdone(il+1:il+1).EQ.clblank)
+        kleng_aux = kleng_aux +1
+        il = il+1
+        IF (il+1.GT.klen) GO TO 130
+      ENDDO
+  ENDIF
+130 CONTINUE
+  clwork = ADJUSTL ( cdone)
+!
+!* - If there are no more characters, kleng=-1
+!
+  IF ( LEN_TRIM ( clwork) .LE. 0) THEN
+      kleng = -1
+!      call oasis_debug_exit(subname)
+      RETURN
+  END IF
+!
+!* - If this is the one we're looking for, skip
+!    otherwise go knumb-1 more sets of characters
+!
+  IF (knumb .GE. 2) THEN
+      DO jl = 1, knumb-1
+        ii = INDEX ( clwork, clblank) - 1
+        il = ii + 1 
+        DO WHILE (clwork(il:il).EQ.clblank)
+          kleng_aux = kleng_aux +1
+          il = il + 1
+          IF (il.GT.klen) GO TO 140
+        ENDDO
+140 CONTINUE
+        kleng_aux = kleng_aux + ii
+        clwork ( 1:ii) = clblank
+        clwork = ADJUSTL ( clwork)
+!
+!* - If there are no more characters, kleng=-1
+!
+        IF (LEN_TRIM ( clwork) .LE. 0) THEN
+            kleng = -1
+!            call oasis_debug_exit(subname)
+            RETURN
+        END IF
+      END DO
+  END IF
+!
+!* - Find the length of the rest of the line
+!
+  kleng = klen - kleng_aux
+!
+!* - Copy to cdtwo
+!
+  cdtwo ( 1:kleng) = clwork ( 1: kleng)
+!
+!*    3. End of routine
+!        --------------
+!
+
+!  call oasis_debug_exit(subname)
+
+  END SUBROUTINE parseblk
+!===============================================================================
+
+  SUBROUTINE skip (cd_one, id_len, endflag)
+!
+!**** SKIP
+!
+!     Purpose:
+!       Skip line if it is a comment
+!
+!     Interface: 
+!       Call skip (cl_one)
+!
+!     Method:
+!       Read the first caracter of the line and skip line if 
+!       it is a comment
+!
+!     External:
+!       none
+!
+!     Files:
+!       none
+!   
+!     References:
+!
+!     History:
+!     --------
+!       Version   Programmer     Date        Description
+!       ------------------------------------------------
+!       2.5       A.Caubel       2002/04/04  created
+!
+!*-----------------------------------------------------------------------
+!
+      IMPLICIT NONE
+!
+!** + DECLARATIONS
+!
+!
+!** ++ Include files
+!
+!** ++ Argument declarations
+!
+  INTEGER (kind=ip_intwp_p),intent(in) :: id_len
+  CHARACTER(len=*),intent(inout)       :: cd_one
+  LOGICAL, optional, intent(inout)     :: endflag
+!
+!** ++ Local declarations
+!
+  INTEGER (kind=ip_intwp_p) :: ib
+  CHARACTER(len=1000) :: cl_line
+  CHARACTER(len=1) :: cl_two
+  character(len=*),parameter :: subname='mod_oasis_namcouple:skip'
+!
+!*-----------------------------------------------------------------------
+!
+!  call oasis_debug_enter(subname)
+
+  cl_two='#'
+100 IF (cd_one(1:1) .NE. cl_two) GO TO 120
+  if (present(endflag)) then
+     endflag = .false.
+     READ (UNIT = nulin, FMT = 1001, END=140) cl_line
+  else
+     READ (UNIT = nulin, FMT = 1001) cl_line
+  endif
+  cd_one = trim(cl_line)
+  GO TO 100
+120 CONTINUE 
+  RETURN
+140 CONTINUE
+  ENDFLAG = .true.
+  RETURN
+1001 FORMAT(A1000)
+!
+!*-----------------------------------------------------------------------
+!
+!  call oasis_debug_exit(subname)
+
+  END SUBROUTINE skip
+!
+!*========================================================================
+!===============================================================================
+!===============================================================================
+END MODULE mod_oasis_namcouple
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_parameters.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_parameters.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_parameters.F90	(revision 4775)
@@ -0,0 +1,155 @@
+MODULE mod_oasis_parameters
+!
+! -- clim.h   18-08-95   Version 2.0   Author: Laurent Terray
+!    ******
+!             26-10-99   Version 2.4   Jean Latour (F.S.E.) MPI-2 support
+!@
+! -- mod_clim_proto.f90  12-06-02  Version 3.0   A. Caubel 
+! --                     20-05-03  added PRISM_Recvd/Sent   S.Legutke
+     
+!    ******************
+!
+!@  Contents : variables related to the CLIM library
+!@  --------
+!@
+!
+  USE mod_oasis_kinds
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Ok	 = 0 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Ok       = PRISM_Ok
+
+!-----Ports status
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_NotDef            = -2 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_NotDef            = PRISM_NotDef
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Var_Uncpl         = -1
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Out               = 20 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Out               = PRISM_Out
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_In                = 21
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_In                = PRISM_In
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_InOut             = 2 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_InOut             = PRISM_InOut
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Recvd             = 3 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Recvd             = PRISM_Recvd
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Sent              = 4 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Sent              = PRISM_Sent
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_LocTrans          = 5
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_LocTrans          = PRISM_LocTrans
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_ToRest            = 6
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_ToRest            = PRISM_ToRest
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Output            = 7
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Output            = PRISM_Output
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_SentOut           = 8
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_SentOut           = PRISM_SentOut
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_ToRestOut         = 9
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_ToRestOut         = PRISM_ToRestOut
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_FromRest          = 10
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_FromRest          = PRISM_FromRest
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Input             = 11
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Input             = PRISM_Input
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_RecvOut           = 12
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_RecvOut           = PRISM_RecvOut
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_FromRestOut       = 13
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_FromRestOut       = PRISM_FromRestOut
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Waitforallingroup = 14
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Waitforallingroup = PRISM_Waitforallingroup
+
+!-----Coupler Comm Status
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_NONE        = 100
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_NONE        = PRISM_NONE
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_COMM_READY  = 101
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_COMM_READY  = PRISM_COMM_READY
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_COMM_WAIT   = 102
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_COMM_WAIT   = PRISM_COMM_WAIT
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_PUT         = 103
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS3_PUT         = PRISM_PUT
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_GET         = 104
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS3_GET         = PRISM_GET
+
+!-----Field status
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_exported  = 1
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_ignored   = 2
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_input     = 3
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_output    = 4
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_expout    = 5
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_ignout    = 6
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_auxilary  = 7
+
+!----Field local transformation
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_instant = 1
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_average = 2
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_accumul = 3
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_min     = 4
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_max     = 5
+
+!----Field conserv option
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_cnone   = 0
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_cglobal = 1
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_cglbpos = 2
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_cbasbal = 4
+  INTEGER (kind=ip_intwp_p), PARAMETER :: ip_cbaspos = 5
+
+!-----Parallel distribution
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Strategy = 1 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Segments = 2 
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Serial   = 0 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Apple    = 1 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Box      = 2 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Orange   = 3 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Points   = 4 
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Offset   = 2 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Length   = 3 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_SizeX    = 3 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_SizeY    = 4 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_LdX      = 5 
+
+!-----Datatypes
+
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Real   = 4  
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Real   = PRISM_Real
+  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_Double = 8 
+  INTEGER (kind=ip_intwp_p), PARAMETER :: OASIS_Double = PRISM_Double
+
+!-----Quit parameters
+!
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_ContPvm = 0 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_StopPvm = 1 
+!
+!-----Error Codes
+!
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_MaxCodes  = -22 
+!
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Ok	 = 0 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_FastExit  = -1 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_BadName   = -2 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_BadPort   = -3 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_BadType   = -4 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_DoubleDef= -5 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_NotStep   = -6 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_IncStep   = -7 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_IncSize   = -8 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_NotClim   = -9 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_TimeOut   = -10 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Pvm       = -11 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_FirstCall = -12 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_PbRoute   = -13 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Group     = -14 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_BadTaskId = -15 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_NoTask    = -16 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_InitBuff  = -17 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Pack      = -18 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Unpack    = -19 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Down      = -20 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_PvmExit   = -21 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: CLIM_Mpi       = -22 
+!  INTEGER (kind=ip_intwp_p), PARAMETER :: PRISM_NotFreq  = -23 
+!
+
+END MODULE mod_oasis_parameters
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_part.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_part.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_part.F90	(revision 4775)
@@ -0,0 +1,257 @@
+MODULE mod_oasis_part
+
+   USE mod_oasis_kinds
+   USE mod_oasis_data
+   USE mod_oasis_parameters
+   USE mod_oasis_sys
+   USE mod_oasis_timer
+   USE mct_mod
+
+   implicit none
+
+   private
+
+   !--- interfaces ---
+   public :: oasis_def_partition
+   public :: oasis_part_create
+
+   !--- datatypes ---
+   public :: prism_part_type
+
+   integer(kind=ip_intwp_p),parameter :: mpart = 100
+
+   type prism_part_type
+      type(mct_gsmap)        :: gsmap
+      integer(kind=ip_i4_p)  :: gsize
+      integer(kind=ip_i4_p)  :: nx
+      integer(kind=ip_i4_p)  :: ny
+      character(len=ic_med)  :: gridname
+   end type prism_part_type
+
+   integer(kind=ip_intwp_p),public :: prism_npart = 0
+   type(prism_part_type),public :: prism_part(mpart)
+
+CONTAINS
+!
+  SUBROUTINE oasis_def_partition (id_part, kparal, kinfo, ig_size)
+!
+!*    *** Def_partition ***   PRISM 1.0
+!
+!     purpose:
+!     --------
+!        define a decomposition
+!
+!     interface:
+!     ----------
+!        id_part : field decomposition id
+!        kparal : type of parallel decomposition
+!	 kinfo	: output status
+!
+!     author:
+!     -------
+!        Arnaud Caubel - FECIT
+!
+!  ----------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p)              ,intent(out) :: id_part
+   INTEGER(kind=ip_intwp_p), DIMENSION(:),intent(in)  :: kparal
+   INTEGER(kind=ip_intwp_p), optional    ,intent(out) :: kinfo
+   INTEGER(kind=ip_intwp_p), optional    ,intent(in)  :: ig_size
+!  ----------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p) :: n,k,nsegs,numel
+   INTEGER(kind=ip_intwp_p) :: len
+   integer(kind=ip_intwp_p),pointer :: start(:),length(:)
+   character(len=*),parameter :: subname = 'oasis_def_partition'
+!  ----------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   kinfo = OASIS_OK
+
+   call oasis_timer_start('map definition')
+
+   if (prism_npart == 0) then  ! first call
+      do n = 1,mpart
+         prism_part(n)%gsize = -1
+         prism_part(n)%nx    = -1
+         prism_part(n)%ny    = -1
+         prism_part(n)%gridname = trim(cspval)
+      enddo
+   endif
+
+   prism_npart = prism_npart + 1
+   id_part = prism_npart
+
+   if (prism_npart > mpart) then
+      write(nulprt,*) subname,' ERROR prism_npart too large ',prism_npart,mpart
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   if (kparal(CLIM_Strategy) == CLIM_Serial) then
+      nsegs = 1
+      allocate(start(nsegs),length(nsegs))
+      start (1) = 1
+      length(1) = kparal(CLIM_Length)
+      numel = nsegs
+      if (length(1) == 0) numel = 0
+   elseif (kparal(CLIM_Strategy) == CLIM_Apple) then
+      nsegs = 1
+      allocate(start(nsegs),length(nsegs))
+      start (1) = kparal(CLIM_Offset) + 1
+      length(1) = kparal(CLIM_Length)
+      numel = nsegs
+      if (length(1) == 0) numel = 0
+   elseif (kparal(CLIM_Strategy) == CLIM_Box) then
+      nsegs = kparal(CLIM_SizeY)
+      allocate(start(nsegs),length(nsegs))
+      do n = 1,nsegs
+         start (n) = kparal(CLIM_Offset) + (n-1)*kparal(CLIM_LdX) + 1
+         length(n) = kparal(CLIM_SizeX)
+      enddo
+      numel = nsegs
+      if (kparal(CLIM_SizeY)*kparal(CLIM_SizeX) == 0) numel = 0
+   elseif (kparal(CLIM_Strategy) == CLIM_Orange) then
+      nsegs = kparal(CLIM_Segments)
+      allocate(start(nsegs),length(nsegs))
+      numel = 0
+      do n = 1,nsegs
+        len = kparal((n-1)*2 + 4)
+        IF (len > 0) THEN
+            numel = numel + 1
+            start(numel)  = kparal((n-1)*2 + 3) + 1
+            length(numel) = len
+        ENDIF
+      ENDDO 
+   elseif (kparal(CLIM_Strategy) == CLIM_Points) then
+      nsegs = kparal(CLIM_Segments)
+      allocate(start(nsegs),length(nsegs))
+      !--- initialize first segment, nsegs=1,n=1,k=3
+      nsegs = 1
+      n = 1
+      k = n+2
+      start(nsegs)  = kparal(k)
+      length(nsegs) = 1
+      !--- compute rest of segments from n=2,k=4
+      do n = 2,kparal(CLIM_Segments)
+         k = n+2
+         if (kparal(k)-kparal(k-1) == 1) then
+            length(nsegs) = length(nsegs) + 1
+         else
+            nsegs = nsegs + 1
+            start(nsegs)  = kparal(k)
+            length(nsegs) = 1
+         endif
+      enddo
+      numel = nsegs
+   else
+      write(nulprt,*) subname,' ERROR part strategy unknown ',kparal(CLIM_Strategy)
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+
+   if (mpi_comm_local /= MPI_COMM_NULL) then
+      if (present(ig_size)) then
+         call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,mpi_root_local,&
+                             mpi_comm_local,compid,numel=numel,gsize=ig_size)
+      else
+         call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,mpi_root_local,&
+                             mpi_comm_local,compid,numel=numel)
+      endif
+      prism_part(prism_npart)%gsize = mct_gsmap_gsize(prism_part(prism_npart)%gsmap)
+   else
+      prism_part(prism_npart)%gsize = -1
+   endif
+
+   deallocate(start,length)
+
+   prism_part(prism_npart)%nx = -1
+   prism_part(prism_npart)%ny = -1
+  
+   call oasis_timer_stop('map definition')
+   
+   if (OASIS_debug >= 2) then
+      write(nulprt,*) ' '
+      write(nulprt,*) subname,' compid = ',prism_part(prism_npart)%gsmap%comp_id
+      write(nulprt,*) subname,' ngseg  = ',prism_part(prism_npart)%gsmap%ngseg
+      write(nulprt,*) subname,' gsize  = ',prism_part(prism_npart)%gsmap%gsize
+      IF (mpi_comm_local /= MPI_COMM_NULL) THEN
+          WRITE(nulprt,*) subname,' start  = ',prism_part(prism_npart)%gsmap%start
+          WRITE(nulprt,*) subname,' length = ',prism_part(prism_npart)%gsmap%length
+          WRITE(nulprt,*) subname,' pe_loc = ',prism_part(prism_npart)%gsmap%pe_loc
+      ENDIF
+      write(nulprt,*) ' '
+      CALL oasis_flush(nulprt)
+   endif
+
+   call oasis_debug_exit(subname)
+
+ END SUBROUTINE oasis_def_partition
+
+!------------------------------------------------------------
+  SUBROUTINE oasis_part_create(id_part,TYPE,gsize,nx,ny,gridname)
+
+  IMPLICIT NONE
+
+  integer(ip_i4_p),intent(out) :: id_part
+  character(len=*),intent(in)  :: type
+  integer(ip_i4_p),intent(in)  :: gsize
+  integer(ip_i4_p),intent(in)  :: nx
+  integer(ip_i4_p),intent(in)  :: ny
+  character(len=*),intent(in)  :: gridname
+  !--------------------------------------------------------
+  integer(ip_i4_p) :: mpicomm
+  integer(ip_i4_p) :: mpirank
+  integer(ip_i4_p) :: mpisize
+  integer(ip_i4_p),pointer :: start(:),length(:)
+  integer(ip_i4_p) :: pts
+  integer(ip_i4_p) :: n
+  character(len=*),parameter :: subname = 'oasis_part_create'
+  !--------------------------------------------------------
+
+  call oasis_debug_enter(subname)
+
+  mpicomm = mpi_comm_local
+  mpirank = mpi_rank_local
+  mpisize = mpi_size_local
+
+  !--- before initializing another gsmap, check if one exists that will work
+  do n = 1,prism_npart
+     if (prism_part(n)%gsize == gsize .and. &
+         trim(prism_part(n)%gridname) == trim(gridname) .and. &
+         prism_part(n)%nx == nx .and. &
+         prism_part(n)%ny == ny) then
+        id_part = n
+        call oasis_debug_exit(subname)
+        return
+     endif
+  enddo
+
+  if (trim(type) == '1d') then
+     allocate(start(1),length(1))
+     length(1) = gsize/mpisize
+     pts = gsize - length(1)*mpisize
+     if (mpirank < pts) length(1) = length(1) + 1
+     start(1) = gsize/mpisize*(mpirank) + min(mpirank,pts) + 1
+     prism_npart = prism_npart + 1
+     prism_part(prism_npart)%gsize = gsize
+     prism_part(prism_npart)%nx = -1
+     prism_part(prism_npart)%ny = -1
+     call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,0,mpicomm,compid)
+     deallocate(start,length)
+  else
+     write(nulprt,*) subname,' ERROR type unknown ',trim(type)
+     WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+     CALL oasis_flush(nulprt)
+     call oasis_abort_noarg()
+  endif
+
+  id_part = prism_npart
+
+  call oasis_debug_exit(subname)
+
+END SUBROUTINE oasis_part_create
+!------------------------------------------------------------
+
+END MODULE mod_oasis_part
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_string.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_string.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_string.F90	(revision 4775)
@@ -0,0 +1,1736 @@
+#define NEW_LGI_METHOD2a
+!#define NEW_LGI_METHOD2b
+!===============================================================================
+!BOP ===========================================================================
+!
+! !MODULE: mod_oasis_string -- string and list methods
+!
+! !DESCRIPTION:
+!    General string and specific list method.  A list is a single string
+!    that is delimited by a character forming multiple fields, ie,
+!    character(len=*) :: mylist = "t:s:u1:v1:u2:v2:taux:tauy"
+!    The delimiter is called listDel in this module, is default ":",
+!    but can be set by a call to oasis_string_listSetDel.
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+module mod_oasis_string
+
+! !USES:
+
+   use mod_oasis_kinds
+   use mod_oasis_parameters
+   use mod_oasis_data
+   use mod_oasis_sys
+   use mod_oasis_timer
+
+   implicit none
+   private
+
+! !PUBLIC TYPES:
+
+   ! no public types
+
+! !PUBLIC MEMBER FUNCTIONS:
+
+   public :: oasis_string_countChar       ! Count number of char in string, fn
+   public :: oasis_string_toUpper         ! Convert string to upper-case
+   public :: oasis_string_toLower         ! Convert string to lower-case
+   public :: oasis_string_getParentDir    ! For a pathname get the parent directory name
+   public :: oasis_string_lastIndex       ! Index of last substr in str
+   public :: oasis_string_endIndex        ! Index of end of substr in str
+   public :: oasis_string_leftAlign       ! remove leading white space
+   public :: oasis_string_alphanum        ! remove all non alpha-numeric characters
+   public :: oasis_string_betweenTags     ! get the substring between the two tags
+   public :: oasis_string_parseCFtunit    ! parse CF time units
+   public :: oasis_string_clean           ! Set string to all white space
+
+   public :: oasis_string_listIsValid     ! test for a valid "list"
+   public :: oasis_string_listGetNum      ! Get number of fields in list, fn
+   public :: oasis_string_listGetIndex    ! Get index of field
+   public :: oasis_string_listGetIndexF   ! function version of listGetIndex
+   public :: oasis_string_listGetName     ! get k-th field name
+   public :: oasis_string_listIntersect   ! get intersection of two field lists
+   public :: oasis_string_listUnion       ! get union of two field lists
+   public :: oasis_string_listMerge       ! merge two lists to form third
+   public :: oasis_string_listAppend      ! append list at end of another
+   public :: oasis_string_listPrepend     ! prepend list in front of another
+   public :: oasis_string_listSetDel      ! Set field delimeter in lists
+   public :: oasis_string_listGetDel      ! Get field delimeter in lists
+
+   public :: oasis_string_setAbort        ! set local abort flag
+   public :: oasis_string_setDebug        ! set local debug flag
+
+! !PUBLIC DATA MEMBERS:
+
+   ! no public data members
+
+!EOP
+
+   character(len=1)    ,save :: listDel  = ":"    ! note single exec implications
+   character(len=2)    ,save :: listDel2 = "::"   ! note single exec implications
+   logical             ,save :: doabort  = .true.
+   integer(ip_i4_p),save :: debug    = 0
+
+!===============================================================================
+contains
+!===============================================================================
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_countChar -- Count number of occurances of a character
+!
+! !DESCRIPTION:
+!  count number of occurances of a single character in a string
+!     \newline
+!     n = shr\_string\_countChar(string,character)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+integer function oasis_string_countChar(str,char,rc)
+
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(in)           :: str   ! string to search
+   character(1)        ,intent(in)           :: char  ! char to search for
+   integer(ip_i4_p),intent(out),optional :: rc    ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p) :: count    ! counts occurances of char
+   integer(ip_i4_p) :: n        ! generic index
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_countChar) "
+   character(*),parameter :: F00     = "('(oasis_string_countChar) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   count = 0
+   do n = 1, len_trim(str)
+      if (str(n:n) == char) count = count + 1
+   end do
+   oasis_string_countChar = count
+
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_countChar
+
+!===============================================================================
+!BOP ===========================================================================
+! !IROUTINE: oasis_string_toUpper -- Convert string to upper case
+!
+! !DESCRIPTION:
+!     Convert the input string to upper-case.
+!     Use achar and iachar intrinsics to ensure use of ascii collating sequence.
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+function oasis_string_toUpper(str)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+   character(len=*), intent(in) :: str      ! String to convert to upper case
+   character(len=len(str))      :: oasis_string_toUpper
+
+   !----- local -----
+   integer(ip_i4_p) :: i             ! Index
+   integer(ip_i4_p) :: aseq          ! ascii collating sequence
+   integer(ip_i4_p) :: LowerToUpper  ! integer to convert case
+   character(len=1)     :: ctmp          ! Character temporary
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_toUpper) "
+   character(*),parameter :: F00     = "('(oasis_string_toUpper) ',4a)"
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   LowerToUpper = iachar("A") - iachar("a")
+
+   do i = 1, len(str)
+      ctmp = str(i:i)
+      aseq = iachar(ctmp)
+      if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) &
+           ctmp = achar(aseq + LowertoUpper)
+      oasis_string_toUpper(i:i) = ctmp
+   end do
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_toUpper
+
+!===============================================================================
+!BOP ===========================================================================
+! !IROUTINE: oasis_string_toLower -- Convert string to lower case
+!
+! !DESCRIPTION:
+!     Convert the input string to lower-case.
+!     Use achar and iachar intrinsics to ensure use of ascii collating sequence.
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+function oasis_string_toLower(str)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+   character(len=*), intent(in) :: str      ! String to convert to lower case
+   character(len=len(str))      :: oasis_string_toLower
+
+   !----- local -----
+   integer(ip_i4_p) :: i            ! Index
+   integer(ip_i4_p) :: aseq         ! ascii collating sequence
+   integer(ip_i4_p) :: UpperToLower ! integer to convert case
+   character(len=1)     :: ctmp         ! Character temporary
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_toLower) "
+   character(*),parameter :: F00     = "('(oasis_string_toLower) ',4a)"
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   UpperToLower = iachar("a") - iachar("A")
+
+   do i = 1, len(str)
+      ctmp = str(i:i)
+      aseq = iachar(ctmp)
+      if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) &
+           ctmp = achar(aseq + UpperToLower)
+      oasis_string_toLower(i:i) = ctmp
+   end do
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_toLower
+
+!===============================================================================
+!BOP ===========================================================================
+! !IROUTINE: oasis_string_getParentDir -- For pathname get the parent directory name
+!
+! !DESCRIPTION:
+!     Get the parent directory name for a pathname.
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+function oasis_string_getParentDir(str)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+   character(len=*), intent(in) :: str      ! String to convert to lower case
+   character(len=len(str))      :: oasis_string_getParentDir
+
+   !----- local -----
+   integer(ip_i4_p) :: i       ! Index
+   integer(ip_i4_p) :: nlen    ! Length of string
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_getParentDir) "
+   character(*),parameter :: F00     = "('(oasis_string_getParentDir) ',4a)"
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   nlen = len_trim(str)
+   if ( str(nlen:nlen) == "/" ) nlen = nlen - 1
+   i = index( str(1:nlen), "/", back=.true. )
+   if ( i == 0 )then
+      oasis_string_getParentDir = str
+   else
+      oasis_string_getParentDir = str(1:i-1)
+   end if
+   
+   call oasis_debug_exit(subname)
+
+end function oasis_string_getParentDir
+
+!===============================================================================
+!BOP ===========================================================================
+!
+!
+! !IROUTINE: oasis_string_lastIndex -- Get index of last substr within string
+!
+! !DESCRIPTION:
+!  Get index of last substr within string
+!     \newline
+!     n = shr\_string\_lastIndex(string,substring)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+integer function oasis_string_lastIndex(string,substr,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(in)           :: string ! string to search
+   character(*)        ,intent(in)           :: substr ! sub-string to search for
+   integer(ip_i4_p),intent(out),optional :: rc     ! return code
+
+!EOP
+
+   !--- local ---
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_lastIndex) "
+   character(*),parameter :: F00     = "('(oasis_string_lastIndex) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Note: 
+! - "new" F90 back option to index function makes this home-grown solution obsolete
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   oasis_string_lastIndex = index(string,substr,.true.)
+
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_lastIndex
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_endIndex -- Get the ending index of substr within string
+!
+! !DESCRIPTION:
+!  Get the ending index of substr within string
+!     \newline
+!     n = shr\_string\_endIndex(string,substring)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+integer function oasis_string_endIndex(string,substr,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(in)           :: string ! string to search
+   character(*)        ,intent(in)           :: substr ! sub-string to search for
+   integer(ip_i4_p),intent(out),optional :: rc     ! return code
+
+!EOP
+
+   !--- local ---
+   integer(ip_i4_p)   :: i       ! generic index
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_endIndex) "
+   character(*),parameter :: F00     = "('(oasis_string_endIndex) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! * returns zero if substring not found, uses len_trim() intrinsic
+! * very similar to: i = index(str,substr,back=.true.) 
+! * do we need this function?
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   i = index(trim(string),trim(substr))
+   if ( i == 0 ) then
+      oasis_string_endIndex = 0  ! substr is not in string
+   else
+      oasis_string_endIndex = i + len_trim(substr) - 1
+   end if
+
+!  -------------------------------------------------------------------
+!  i = index(trim(string),trim(substr),back=.true.)
+!  if (i == len(string)+1) i = 0
+!  oasis_string_endIndex = i
+!  -------------------------------------------------------------------
+
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_endIndex
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_leftAlign -- remove leading white space
+!
+! !DESCRIPTION:
+!    Remove leading white space
+!     \newline
+!     call shr\_string\_leftAlign(string)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_leftAlign(str,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(inout)          :: str
+   integer(ip_i4_p),intent(out)  ,optional :: rc   ! return code
+
+!EOP
+
+   !----- local ----
+   integer(ip_i4_p) :: rCode ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_leftAlign) "
+   character(*),parameter :: F00     = "('(oasis_string_leftAlign) ',4a)"
+
+!-------------------------------------------------------------------------------
+! note: 
+! * ?? this routine isn't needed, use the intrisic adjustL instead ??
+!-------------------------------------------------------------------------------
+
+!  -------------------------------------------------------------------
+!  --- used this until I discovered the intrinsic function below
+!  do while (len_trim(str) > 0 ) 
+!     if (str(1:1) /= ' ') exit
+!     str = str(2:len_trim(str))
+!  end do
+!  rCode = 0
+!  !! (len_trim(str) == 0 ) rCode = 1  ! ?? appropriate ??
+!  -------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   str = adjustL(str)
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_leftAlign
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_alphanum -- remove non alpha numeric characters
+!
+! !DESCRIPTION:
+!    Remove all non alpha numeric characters from string
+!     \newline
+!     call shr\_string\_alphanum(string)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_alphanum(str,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(inout)          :: str
+   integer(ip_i4_p),intent(out)  ,optional :: rc   ! return code
+
+!EOP
+
+   !----- local ----
+   integer(ip_i4_p) :: rCode  ! return code
+   integer(ip_i4_p) :: n,icnt ! counters
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_alphaNum) "
+   character(*),parameter :: F00     = "('(oasis_string_alphaNum) ',4a)"
+
+!-------------------------------------------------------------------------------
+!
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   icnt = 0
+   do n=1,len_trim(str)
+     if ((str(n:n) >= 'a' .and. str(n:n) <= 'z') .or.  &
+         (str(n:n) >= 'A' .and. str(n:n) <= 'Z') .or.  &
+         (str(n:n) >= '0' .and. str(n:n) <= '9')) then
+       icnt = icnt + 1
+       str(icnt:icnt) = str(n:n)
+     endif
+   enddo
+   do n=icnt+1,len(str)
+     str(n:n) = ' '
+   enddo
+
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_alphanum
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_betweenTags -- Get the substring between the two tags.
+!
+! !DESCRIPTION:
+!    Get the substring found between the start and end tags.
+!    \newline
+!    call shr\_string\_betweenTags(string,startTag,endTag,substring,rc)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_betweenTags(string,startTag,endTag,substr,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(in)  :: string      ! string to search
+   character(*)        ,intent(in)  :: startTag    ! start tag
+   character(*)        ,intent(in)  :: endTag      ! end tag
+   character(*)        ,intent(out) :: substr      ! sub-string between tags
+   integer(ip_i4_p),intent(out),optional :: rc ! retrun code
+
+!EOP
+
+   !--- local ---
+   integer(ip_i4_p)   :: iStart  ! substring start index
+   integer(ip_i4_p)   :: iEnd    ! substring end   index
+   integer(ip_i4_p)   :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_betweenTags) "
+   character(*),parameter :: F00     = "('(oasis_string_betweenTags) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! * assumes the leading/trailing white space is not part of start & end tags
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   iStart = oasis_string_endIndex(string,trim(adjustL(startTag))) ! end of start tag
+   iEnd   =               index(string,trim(adjustL(endTag  ))) ! start of end tag
+
+   rCode = 0
+   substr = ""
+
+   if (iStart < 1) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) "ERROR: can't find start tag in string"
+       WRITE(nulprt,F00) "ERROR: start tag = ",TRIM(startTag)
+       WRITE(nulprt,F00) "ERROR: string    = ",TRIM(string)
+       CALL oasis_flush(nulprt)
+       rCode = 1
+   else if (iEnd < 1) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) "ERROR: can't find end tag in string"
+       WRITE(nulprt,F00) "ERROR: end   tag = ",TRIM(  endTag)
+       WRITE(nulprt,F00) "ERROR: string    = ",TRIM(string)
+       CALL oasis_flush(nulprt)
+       rCode = 2
+   else if ( iEnd <= iStart) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) "ERROR: start tag not before end tag"
+       WRITE(nulprt,F00) "ERROR: start tag = ",TRIM(startTag)
+       WRITE(nulprt,F00) "ERROR: end   tag = ",TRIM(  endTag)
+       WRITE(nulprt,F00) "ERROR: string    = ",TRIM(string)
+       CALL oasis_flush(nulprt)
+       rCode = 3
+   else if ( iStart+1 == iEnd ) then
+      substr = ""
+      WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+      WRITE(nulprt,F00) "WARNING: zero-length substring found in ",TRIM(string)
+      CALL oasis_flush(nulprt)
+   else
+      substr = string(iStart+1:iEnd-1)
+      IF (LEN_TRIM(substr) == 0) THEN
+          WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+          WRITE(nulprt,F00) "WARNING: white-space substring found in ",TRIM(string)
+          CALL oasis_flush(nulprt)
+     ENDIF
+   end if
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_betweenTags
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_parseCFtunit -- Parse CF time unit
+!
+! !DESCRIPTION:
+!  Parse CF time unit into a delta string name and a base time in yyyymmdd
+!  and seconds (nearest integer actually).
+!     \newline
+!     call shr\_string\_parseCFtunit(string,substring)
+!     \newline
+!  Input string is like "days since 0001-06-15 15:20:45.5 -6:00"
+!    - recognizes "days", "hours", "minutes", "seconds"
+!    - must have at least yyyy-mm-dd, hh:mm:ss.s is optional
+!    - expects a "since" in the string
+!    - ignores time zone part
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_parseCFtunit(string,unit,bdate,bsec,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)    ,intent(in)           :: string ! string to search
+   character(*)    ,intent(out)          :: unit   ! delta time unit
+   integer(ip_i4_p),intent(out)          :: bdate  ! base date yyyymmdd
+   real(ip_r8_p)   ,intent(out)          :: bsec   ! base seconds
+   integer(ip_i4_p),intent(out),optional :: rc     ! return code
+
+!EOP
+
+   !--- local ---
+   integer(ip_i4_p)   :: i,i1,i2          ! generic index
+   character(ic_long) :: tbase            ! baseline time
+   character(ic_long) :: lstr             ! local string
+   integer(ip_i4_p)   :: yr,mo,da,hr,min  ! time stuff
+   real(ip_r8_p)      :: sec              ! time stuff
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_parseCFtunit) "
+   character(*),parameter :: F00     = "('(oasis_string_parseCFtunit) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! o assume length of CF-1.0 time attribute char string  < ic_long
+!   This is a reasonable assumption.
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   unit = 'none'
+   bdate = 0
+   bsec = 0.0_ip_r8_p
+
+   i = oasis_string_lastIndex(string,'days ')
+   if (i > 0) unit = 'days'
+   i = oasis_string_lastIndex(string,'hours ')
+   if (i > 0) unit = 'hours'
+   i = oasis_string_lastIndex(string,'minutes ')
+   if (i > 0) unit = 'minutes'
+   i = oasis_string_lastIndex(string,'seconds ')
+   if (i > 0) unit = 'seconds'
+
+   if (trim(unit) == 'none') then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) ' ERROR time unit unknown'
+       CALL oasis_flush(nulprt)
+       CALL oasis_string_abort(subName//' time unit unknown')
+   endif
+
+   i = oasis_string_lastIndex(string,' since ')
+   if (i < 1) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) ' ERROR since does not appear in unit attribute for time '
+       CALL oasis_flush(nulprt)
+       CALL oasis_string_abort(subName//' no since in attr name')
+   endif
+   tbase = trim(string(i+6:))
+   call oasis_string_leftAlign(tbase)
+
+   if (debug > 0 .and. nulprt > 0) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,*) TRIM(subName)//' '//'unit '//TRIM(unit)
+       WRITE(nulprt,*) TRIM(subName)//' '//'tbase '//TRIM(tbase)
+       CALL oasis_flush(nulprt)
+   endif
+
+   yr=0; mo=0; da=0; hr=0; min=0; sec=0
+   i1 = 1
+
+   i2 = index(tbase,'-') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=200) yr
+   tbase = tbase(i2+2:)
+   call oasis_string_leftAlign(tbase)
+
+   i2 = index(tbase,'-') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=200) mo
+   tbase = tbase(i2+2:)
+   call oasis_string_leftAlign(tbase)
+
+   i2 = index(tbase,' ') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=200) da
+   tbase = tbase(i2+2:)
+   call oasis_string_leftAlign(tbase)
+
+   i2 = index(tbase,':') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=100) hr
+   tbase = tbase(i2+2:)
+   call oasis_string_leftAlign(tbase)
+
+   i2 = index(tbase,':') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=100) min
+   tbase = tbase(i2+2:)
+   call oasis_string_leftAlign(tbase)
+
+   i2 = index(tbase,' ') - 1
+   lstr = tbase(i1:i2)
+   read(lstr,*,ERR=200,END=100) sec
+
+100  continue
+
+   IF (debug > 0 ) THEN
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,*) TRIM(subName),'ymdhms:',yr,mo,da,hr,min,sec
+       CALL oasis_flush(nulprt)
+   ENDIF
+
+   bdate = abs(yr)*10000 + mo*100 + da
+   if (yr < 0) bdate = -bdate
+   bsec = real(hr*3600 + min*60,ip_r8_p) + sec
+
+   if (present(rc)) rc = 0
+
+   call oasis_debug_exit(subname)
+   return
+
+200  continue
+   WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+   write(nulprt,F00) 'ERROR 200 on char num read '
+   CALL oasis_flush(nulprt)
+   call oasis_string_abort(subName//' ERROR on char num read')
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_parseCFtunit
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_clean -- Clean a string, set it to "blank"
+!
+! !DESCRIPTION:
+!     Clean a string, set it to blank
+!     \newline
+!     call shr\_string\_clean(string,rc)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_clean(string,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)                 ,intent(inout) :: string  ! list/string
+   integer(ip_i4_p),optional,intent(out)   :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)   :: n       ! counter
+   integer(ip_i4_p)   :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_clean) "
+   character(*),parameter :: F00     = "('(oasis_string_clean) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+   string = '       '
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_clean
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listIsValid -- determine whether string is a valid list
+!
+! !DESCRIPTION:
+!     Determine whether string is a valid list
+!     \newline
+!     logical_var = shr\_string\_listIsValid(list,rc)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+logical function oasis_string_listIsValid(list,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)                 ,intent(in)  :: list    ! list/string
+   integer(ip_i4_p),optional,intent(out) :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer  (ip_i4_p) :: nChar   ! lenth of list
+   integer  (ip_i4_p) :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listIsValid) "
+   character(*),parameter :: F00     = "('(oasis_string_listIsValid) ',4a)"
+
+!-------------------------------------------------------------------------------
+! check that the list conforms to the list format
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+   oasis_string_listIsValid = .true.
+
+   nChar = len_trim(list)
+   if (nChar < 1) then                           ! list is an empty string
+      rCode = 1
+   else if (    list(1:1)     == listDel  ) then ! first char is delimiter
+      rCode = 2 
+   else if (list(nChar:nChar) == listDel  ) then ! last  char is delimiter
+      rCode = 3
+   else if (index(trim(list)," " )     > 0) then ! white-space in a field name
+      rCode = 4
+   else if (index(trim(list),listDel2) > 0) then ! found zero length field
+      rCode = 5
+   end if
+   
+   if (rCode /= 0) then
+      oasis_string_listIsValid = .false.
+      WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+      write(nulprt,F00) "WARNING: invalid list = ",trim(list)
+      CALL oasis_flush(nulprt)
+   endif
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_listIsValid
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listGetName -- Get name of k-th field in list
+!
+! !DESCRIPTION:
+!     Get name of k-th field in list
+!     \newline
+!     call shr\_string\_listGetName(list,k,name,rc)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listGetName(list,k,name,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)                 ,intent(in)  :: list    ! list/string
+   integer(ip_i4_p)         ,intent(in)  :: k       ! index of field
+   character(*)                 ,intent(out) :: name    ! k-th name in list
+   integer(ip_i4_p),optional,intent(out) :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)   :: i,j,n   ! generic indecies
+   integer(ip_i4_p)   :: kFlds   ! number of fields in list
+   integer(ip_i4_p)   :: i0,i1   ! name = list(i0:i1)
+   integer(ip_i4_p)   :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listGetName) "
+   character(*),parameter :: F00     = "('(oasis_string_listGetName) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   !--- check that this is a valid list ---
+   if (.not. oasis_string_listIsValid(list,rCode) ) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+      write(nulprt,F00) "ERROR: invalid list = ",trim(list)
+      CALL oasis_flush(nulprt)
+      call oasis_string_abort(subName//" ERROR: invalid list = "//trim(list))
+   end if
+
+   !--- check that this is a valid index ---
+   kFlds = oasis_string_listGetNum(list)
+   if (k<1 .or. kFlds<k) then
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,*) subName,"ERROR: invalid index = ",k
+       WRITE(nulprt,*) subName,"ERROR:          list = ",TRIM(list)
+       CALL oasis_flush(nulprt)
+       CALL oasis_string_abort(subName//" ERROR: invalid index")
+   end if
+
+   !--- start with whole list, then remove fields before and after desired field ---
+   i0 = 1
+   i1 = len_trim(list)
+
+   !--- remove field names before desired field ---
+   do n=2,k
+      i = index(list(i0:i1),listDel)
+      i0 = i0 + i
+   end do
+
+   !--- remove field names after desired field ---
+   if ( k < kFlds ) then
+      i = index(list(i0:i1),listDel)
+      i1 = i0 + i - 2
+   end if
+
+   !--- copy result into output variable ---
+   name = list(i0:i1)//"   "
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listGetName
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listIntersect -- Get intersection of two field lists
+!
+! !DESCRIPTION:
+!     Get intersection of two fields lists, write into third list
+!     \newline
+!     call shr\_string\_listIntersect(list1,list2,listout)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listIntersect(list1,list2,listout,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)             ,intent(in)  :: list1   ! list/string
+   character(*)             ,intent(in)  :: list2   ! list/string
+   character(*)             ,intent(out) :: listout ! list/string
+   integer(ip_i4_p),optional,intent(out) :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)   :: nf,n1,n2 ! counters
+   character(ic_med)  :: name     ! field name
+   integer(ip_i4_p)   :: rCode    ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listIntersect) "
+   character(*),parameter :: F00     = "('(oasis_string_listIntersect) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   nf = oasis_string_listGetNum(list1)
+   call oasis_string_clean(listout)
+   do n1 = 1,nf
+     call oasis_string_listGetName(list1,n1,name,rCode)
+     n2 = oasis_string_listGetIndexF(list2,name)
+     if (n2 > 0) then
+       call oasis_string_listAppend(listout,name)
+     endif
+   enddo
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listIntersect
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listUnion -- Get union of two field lists
+!
+! !DESCRIPTION:
+!     Get union of two fields lists, write into third list
+!     \newline
+!     call shr\_string\_listUnion(list1,list2,listout)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listUnion(list1,list2,listout,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)             ,intent(in)  :: list1   ! list/string
+   character(*)             ,intent(in)  :: list2   ! list/string
+   character(*)             ,intent(out) :: listout ! list/string
+   integer(ip_i4_p),optional,intent(out) :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)  :: nf,n1,n2 ! counters
+   character(ic_med) :: name     ! field name
+   integer(ip_i4_p)  :: rCode    ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listUnion) "
+   character(*),parameter :: F00     = "('(oasis_string_listUnion) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   call oasis_string_clean(listout)
+
+   nf = oasis_string_listGetNum(list1)
+   do n1 = 1,nf
+     call oasis_string_listGetName(list1,n1,name,rCode)
+     n2 = oasis_string_listGetIndexF(listout,name)
+     if (n2 < 1) then
+       call oasis_string_listAppend(listout,name)
+     endif
+   enddo
+
+   nf = oasis_string_listGetNum(list2)
+   do n1 = 1,nf
+     call oasis_string_listGetName(list2,n1,name,rCode)
+     n2 = oasis_string_listGetIndexF(listout,name)
+     if (n2 < 1) then
+       call oasis_string_listAppend(listout,name)
+     endif
+   enddo
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listUnion
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listMerge -- Merge lists two list to third
+!
+! !DESCRIPTION:
+!     Merge two list to third
+!     \newline
+!     call shr\_string\_listMerge(list1,list2,listout)
+!     call shr\_string\_listMerge(list1,list2,list1)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listMerge(list1,list2,listout,rc)
+
+   implicit none
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)             ,intent(in)  :: list1   ! list/string
+   character(*)             ,intent(in)  :: list2   ! list/string
+   character(*)             ,intent(out) :: listout ! list/string
+   integer(ip_i4_p),optional,intent(out) :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   character(ic_xl) :: l1,l2   ! local char strings
+   integer(ip_i4_p) :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listMerge) "
+   character(*),parameter :: F00     = "('(oasis_string_listMerge) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! - no input or output string should be longer than ic_xl
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   !--- make sure temp strings are large enough ---
+   if ( (len(l1) < len_trim(list1)) .or. (len(l2) < len_trim(list2))) then
+      call oasis_string_abort(subName//'ERROR: temp string not large enough')
+   end if
+
+   call oasis_string_clean(l1)
+   call oasis_string_clean(l2)
+   call oasis_string_clean(listout)
+   l1 = trim(list1)
+   l2 = trim(list2)
+   call oasis_string_leftAlign(l1,rCode)
+   call oasis_string_leftAlign(l2,rCode)
+   if (len_trim(l1)+len_trim(l2)+1 > len(listout)) &
+      call oasis_string_abort(subName//'ERROR: output list string not large enough')
+   if (len_trim(l1) == 0) then
+     listout = trim(l2)
+   else
+     listout = trim(l1)//":"//trim(l2)
+   endif
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listMerge
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listAppend -- Append one list to another
+!
+! !DESCRIPTION:
+!     Append one list to another
+!     \newline
+!     call shr\_string\_listAppend(list,listadd)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listAppend(list,listadd,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)             ,intent(inout) :: list   ! list/string
+   character(*)             ,intent(in)    :: listadd ! list/string
+   integer(ip_i4_p),optional,intent(out)   :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   character(ic_xl) :: l1      ! local string
+   integer(ip_i4_p) :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listAppend) "
+   character(*),parameter :: F00     = "('(oasis_string_listAppend) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! - no input or output string should be longer than ic_xl
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   !--- make sure temp string is large enough ---
+   if (len(l1) < len_trim(listAdd)) then
+      call oasis_string_abort(subName//'ERROR: temp string not large enough')
+   end if
+
+   call oasis_string_clean(l1)
+   l1 = trim(listadd)
+   call oasis_string_leftAlign(l1,rCode)
+   if (len_trim(list)+len_trim(l1)+1 > len(list)) &
+      call oasis_string_abort(subName//'ERROR: output list string not large enough')
+   if (len_trim(list) == 0) then
+     list = trim(l1)
+   else
+     list = trim(list)//":"//trim(l1)
+   endif
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listAppend
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listPrepend -- Prepend one list to another
+!
+! !DESCRIPTION:
+!     Prepend one list to another
+!     \newline
+!     call shr\_string\_listPrepend(listadd,list)
+!     \newline
+!     results in listadd:list
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listPrepend(listadd,list,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)             ,intent(in)    :: listadd ! list/string
+   character(*)             ,intent(inout) :: list   ! list/string
+   integer(ip_i4_p),optional,intent(out)   :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   character(ic_xl) :: l1      ! local string
+   integer(ip_i4_p) :: rCode   ! return code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listPrepend) "
+   character(*),parameter :: F00     = "('(oasis_string_listPrepend) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+! - no input or output string should be longer than ic_xl
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   rCode = 0
+
+   !--- make sure temp string is large enough ---
+   if (len(l1) < len_trim(listAdd)) then
+      call oasis_string_abort(subName//'ERROR: temp string not large enough')
+   end if
+
+   call oasis_string_clean(l1)
+   l1 = trim(listadd)
+   call oasis_string_leftAlign(l1,rCode)
+   call oasis_string_leftAlign(list,rCode)
+   if (len_trim(list)+len_trim(l1)+1 > len(list)) &
+      call oasis_string_abort(subName//'ERROR: output list string not large enough')
+   if (len_trim(l1) == 0) then
+     list = trim(list)
+   else
+     list = trim(l1)//":"//trim(list)
+   endif
+
+   if (present(rc)) rc = rCode
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listPrepend
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listGetIndexF -- Get index of field in string
+!
+! !DESCRIPTION:
+!     Get index of field in string
+!     \newline
+!     k = shr\_string\_listGetIndex(str,"taux")
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+integer function oasis_string_listGetIndexF(string,fldStr)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*),intent(in) :: string   ! string
+   character(*),intent(in) :: fldStr   ! name of field
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)    :: k        ! local index variable
+   integer(ip_i4_p)    :: rc       ! error code
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listGetIndexF) "
+   character(*),parameter :: F00     = "('(oasis_string_listGetIndexF) ',4a)"
+
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   call oasis_string_listGetIndex(string,fldStr,k,print=.false.,rc=rc)
+   oasis_string_listGetIndexF = k
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_listGetIndexF
+
+#if (defined NEW_LGI_METHOD2a || defined NEW_LGI_METHOD2b)
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listGetIndex -- Get index of field in string
+!
+! !DESCRIPTION:
+!     Get index of field in string
+!     \newline
+!     call shr\_string\_listGetIndex(str,"taux",k,rc)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listGetIndex(string,fldStr,kFld,print,rc)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*)        ,intent(in)           :: string  ! string
+   character(*)        ,intent(in)           :: fldStr  ! name of field
+   integer(ip_i4_p),intent(out)          :: kFld    ! index of field
+   logical             ,intent(in) ,optional :: print   ! print switch
+   integer(ip_i4_p),intent(out),optional :: rc      ! return code
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p)   :: n,n1,n2          ! index for colon position
+   integer(ip_i4_p)   :: lens             ! length of string
+   logical            :: found            ! T => field found in fieldNames
+   logical            :: lprint           ! local print flag
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listGetIndex) "
+   character(*),parameter :: F00     = "('(oasis_string_listGetIndex) ',4a)"
+
+!-------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+!   call oasis_timer_start('tcx_slgi0')
+
+!   call oasis_timer_start('tcx_slgia')
+   if (present(rc)) rc = 0
+
+   kfld   = 0
+   found  = .false.
+
+   lprint = .false.
+   if (present(print)) lprint = print
+
+   !--- confirm proper size of input data ---
+   if (len_trim(fldStr) < 1) then
+       IF (lprint) THEN
+           WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+           WRITE(nulprt,F00) "ERROR: input field name has 0 length"
+           CALL oasis_flush(nulprt)
+       ENDIF
+       CALL oasis_string_abort(subName//"invalid field name")
+   end if
+
+!   call oasis_timer_stop('tcx_slgia')
+!   call oasis_timer_start('tcx_slgib')
+
+   lens = len_trim(string)
+
+!   write(nulprt,*) subname,' tcx1 ',string
+!   write(nulprt,*) subname,' tcx2 ',fldStr
+
+   n = index(string,listDel,back=.false.)
+!   write(nulprt,*) subname,' tcx3 ',n
+!   call oasis_timer_start('tcx_slgib')
+!   call oasis_timer_start('tcx_slgic')
+   if (n <= 0) then  ! single field only
+!      call oasis_timer_start('tcx_slgic1')
+      if (trim(fldStr) == string(1:lens)) then
+         found = .true.
+         kFld = 1
+      endif
+!      call oasis_timer_stop('tcx_slgic1')
+!      write(nulprt,*) subname,' tcx4a ',found,kfld
+   elseif (n > 0) then
+      !--- check first string ---
+!      call oasis_timer_start('tcx_slgic2')
+      if (trim(fldStr) == string(1:n-1)) then
+         found = .true.
+         kFld = 1
+      endif          
+!      write(nulprt,*) subname,' tcx4b ',found,kfld
+!      call oasis_timer_stop('tcx_slgic2')
+      !--- check last string ---
+      if (.not.found) then
+!         call oasis_timer_start('tcx_slgic3')
+         n = index(string,listDel,back=.true.)
+         if (trim(fldStr) == string(n+1:lens)) then
+            found = .true.
+            kFld = oasis_string_listGetNum(string)
+         endif
+!         call oasis_timer_stop('tcx_slgic3')
+!         write(nulprt,*) subname,' tcx4c ',found,kfld
+      endif
+      !--- check other strings ---
+      if (.not.found) then
+!         call oasis_timer_start('tcx_slgic4')
+         n = index(string,':'//trim(fldStr)//':',back=.false.)
+!         write(nulprt,*) subname,' tcx5a ',n
+         if (n > 0) then
+            found = .true.
+#if defined NEW_LGI_METHOD2a
+            if (n <= lens) then
+#endif
+#if defined NEW_LGI_METHOD2b
+            if (n <= lens/2) then
+#endif
+!               call oasis_timer_start('tcx_slgic4a')
+               n1 = 0
+               kFld = 1
+               do while (n1 < n) 
+                  kFld = kFld + 1
+                  n2 = index(string(n1+1:lens),listDel,back=.false.)
+                  n1 = n1 + n2
+!                  write(nulprt,*) subname,' tcx5b ',kfld,n2,n1,n
+               enddo
+!               call oasis_timer_stop('tcx_slgic4a')
+            else
+!               call oasis_timer_start('tcx_slgic4b')
+               n1 = lens+1
+               kFld = oasis_string_listGetNum(string) + 1
+!               call oasis_timer_stop('tcx_slgic4b')
+!               call oasis_timer_start('tcx_slgic4c')
+               do while (n1 > n) 
+                  kFld = kFld - 1
+                  n2 = index(string(1:n1-1),listDel,back=.true.)
+                  n1 = n2
+!                  write(nulprt,*) subname,' tcx5c ',kfld,n2,n1,n
+               enddo
+!               call oasis_timer_stop('tcx_slgic4c')
+            endif
+         endif
+!         write(nulprt,*) subname,' tcx4d ',found,kfld
+!         call oasis_timer_stop('tcx_slgic4')
+      endif
+   endif
+
+!   call oasis_timer_stop('tcx_slgic')
+
+!   call oasis_timer_start('tcx_slgid')
+
+   !--- not finding a field is not a fatal error ---
+   if (.not. found) then
+      IF (lprint) THEN
+          WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+          WRITE(nulprt,F00) "FYI: field ",TRIM(fldStr)," not found in list ",TRIM(string)
+          CALL oasis_flush(nulprt)
+      ENDIF
+      if (present(rc)) rc = 1
+   end if
+
+!   call oasis_timer_stop('tcx_slgid')
+!   call oasis_timer_stop('tcx_slgi0')
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listGetIndex
+#endif
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listGetNum -- get number of fields in a string list
+!
+! !DESCRIPTION:
+!  return number of fields in string list
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+integer function oasis_string_listGetNum(str)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*),intent(in) :: str   ! string to search
+
+!EOP
+
+   !----- local -----
+   integer(ip_i4_p) :: count    ! counts occurances of char
+
+   !----- formats -----
+   character(*),parameter :: subName =   "(oasis_string_listGetNum) "
+   character(*),parameter :: F00     = "('(oasis_string_listGetNum) ',4a)"
+
+!-------------------------------------------------------------------------------
+! Notes:
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   oasis_string_listGetNum = 0
+
+   if (len_trim(str) > 0) then
+      count = oasis_string_countChar(str,listDel)
+      oasis_string_listGetNum = count + 1
+   endif
+
+   call oasis_debug_exit(subname)
+
+end function oasis_string_listGetNum
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listSetDel -- Set list delimeter character
+!
+! !DESCRIPTION:
+!     Set field delimeter character in lists
+!     \newline
+!     call shr\_string\_listSetDel(":")
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listSetDel(cflag)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(len=1),intent(in) :: cflag
+
+!EOP
+
+   !--- formats ---
+   character(*),parameter :: subName =   "(oasis_string_listSetDel) "
+   character(*),parameter :: F00     = "('(oasis_string_listSetDel) ',a) "
+
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   IF (debug > 0) THEN
+       WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+       WRITE(nulprt,F00) 'changing listDel from '//TRIM(listDel)//' to '//TRIM(cflag)
+       CALL oasis_flush(nulprt)
+   ENDIF
+   listDel = trim(cflag)
+   listDel2 = listDel//listDel
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listSetDel
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_listGetDel -- Get list delimeter character
+!
+! !DESCRIPTION:
+!     Get field delimeter character in lists
+!     \newline
+!     call shr\_string\_listGetDel(del)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_listGetDel(del)
+
+  implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+  character(*),intent(out) :: del
+
+!EOP
+
+   !--- formats ---
+   character(*),parameter :: subName =   "(oasis_string_listGetDel) "
+   character(*),parameter :: F00     = "('(oasis_string_listGetDel) ',a) "
+
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   del = trim(listDel)
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_listGetDel
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_setAbort -- Set local oasis_string abort flag
+!
+! !DESCRIPTION:
+!     Set local oasis_string abort flag, true = abort, false = print and continue
+!     \newline
+!     call shr\_string\_setAbort(.false.)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_setAbort(flag)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+  logical,intent(in) :: flag
+
+!EOP
+
+   !--- formats ---
+   character(*),parameter :: subName =   "(oasis_string_setAbort) "
+   character(*),parameter :: F00     = "('(oasis_string_setAbort) ',a) "
+
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   if (debug > 0) then
+      if (flag) then
+          WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+          WRITE(nulprt,F00) 'setting abort to true'
+          CALL oasis_flush(nulprt)
+      else
+          WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+          WRITE(nulprt,F00) 'setting abort to false'
+          CALL oasis_flush(nulprt)
+      endif
+   endif
+
+   doabort = flag
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_setAbort
+
+!===============================================================================
+!BOP ===========================================================================
+!
+! !IROUTINE: oasis_string_setDebug -- Set local oasis_string debug level
+!
+! !DESCRIPTION:
+!     Set local oasis_string debug level, 0 = production
+!     \newline
+!     call shr\_string\_setDebug(2)
+!
+!
+! !INTERFACE: ------------------------------------------------------------------
+
+subroutine oasis_string_setDebug(iFlag)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   integer(ip_i4_p),intent(in) :: iFlag ! requested debug level
+
+!EOP
+
+   !--- local ---
+
+   !--- formats ---
+   character(*),parameter :: subName =   "(oasis_string_setDebug) "
+   character(*),parameter :: F00     = "('(oasis_string_setDebug) ',a) "
+   character(*),parameter :: F01     = "('(oasis_string_setDebug) ',a,i3,a,i3) "
+
+!-------------------------------------------------------------------------------
+! NTOE: write statement can be expensive if called many times.
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+!   if (OASIS_debug > 0) write(nulprt,F01) 'changing debug level from ',debug,' to ',iflag
+   debug = iFlag
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_setDebug
+
+!===============================================================================
+!===============================================================================
+
+subroutine oasis_string_abort(string)
+
+   implicit none
+
+! !INPUT/OUTPUT PARAMETERS:
+
+   character(*),optional,intent(in) :: string
+
+!EOP
+
+   !--- local ---
+   character(ic_xl) :: lstring
+   character(*),parameter :: subName =   "(oasis_string_abort)"
+   character(*),parameter :: F00     = "('(oasis_string_abort) ',a)"
+
+!-------------------------------------------------------------------------------
+! NOTE:
+! - no input or output string should be longer than ic_xl
+!-------------------------------------------------------------------------------
+
+   call oasis_debug_enter(subname)
+
+   lstring = ''
+   if (present(string)) lstring = string
+
+   if (doabort) then
+      WRITE(nulprt,*) subname,' abort :',TRIM(lstring)
+      WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+      call oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   else
+      write(nulprt,F00) ' no abort:'//trim(lstring)
+      CALL oasis_flush(nulprt)
+   endif
+
+   call oasis_debug_exit(subname)
+
+end subroutine oasis_string_abort
+
+!===============================================================================
+!===============================================================================
+
+end module mod_oasis_string
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_sys.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_sys.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_sys.F90	(revision 4775)
@@ -0,0 +1,229 @@
+MODULE mod_oasis_sys
+
+   USE mod_oasis_kinds
+   USE mod_oasis_data
+
+   IMPLICIT NONE
+
+   private
+
+   public oasis_abort_noarg
+   public oasis_abort
+   public oasis_flush
+   public oasis_unitsetmin
+   public oasis_unitget
+   public oasis_unitfree
+   public oasis_debug_enter
+   public oasis_debug_exit
+   public oasis_debug_note
+
+   integer(ip_intwp_p),parameter :: muni = 20
+   integer(ip_intwp_p),save :: unitno(muni) = -1
+   integer(ip_intwp_p),save :: maxion
+   integer(ip_intwp_p),parameter :: tree_delta = 2
+   integer(ip_intwp_p),save :: tree_indent = 0
+
+!--------------------------------------------------------------------
+CONTAINS
+!--------------------------------------------------------------------
+
+   SUBROUTINE oasis_abort_noarg()
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER                      :: ierror
+   character(len=*),parameter   :: subname = 'oasis_abort_noarg'
+!--------------------------------------------------------------------
+
+#if defined use_comm_MPI1 || defined use_comm_MPI2
+   CALL MPI_ABORT (mpi_comm_global, 0, ierror)
+#endif
+
+   STOP
+
+ END SUBROUTINE oasis_abort_noarg
+
+!--------------------------------------------------------------------
+
+   SUBROUTINE oasis_abort(id_compid, cd_routine, cd_message)
+
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p),INTENT(in) :: id_compid
+   CHARACTER(len=*), INTENT(in) :: cd_routine
+   CHARACTER(len=*), INTENT(in) :: cd_message
+!--------------------------------------------------------------------
+   INTEGER                      :: ierror
+   character(len=*),parameter   :: subname = 'oasis_abort'
+!--------------------------------------------------------------------
+
+   WRITE (nulprt,'(a)') subname//' from '//TRIM(cd_routine)
+   WRITE (nulprt,'(a)') subname//' error = '//TRIM(cd_message)
+
+#if defined use_comm_MPI1 || defined use_comm_MPI2
+   CALL MPI_ABORT (mpi_comm_global, 0, ierror)
+#endif
+
+   STOP
+
+ END SUBROUTINE oasis_abort
+
+!==========================================================================
+   SUBROUTINE oasis_flush(nu)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p),INTENT(in) :: nu
+!--------------------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_flush'
+!--------------------------------------------------------------------
+
+   CALL FLUSH(nu)
+
+ END SUBROUTINE oasis_flush
+
+!==========================================================================
+   SUBROUTINE oasis_unitget(uio)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p),INTENT(out) :: uio
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p) :: n1
+   logical :: found
+   character(len=*),parameter :: subname = 'oasis_unitget'
+!--------------------------------------------------------------------
+
+   n1 = 0
+   found = .false.
+   do while (n1 < muni .and. .not.found)
+      n1 = n1 + 1
+      if (unitno(n1) < 0) then
+         found = .true.
+         uio = n1 + maxion
+         unitno(n1) = uio
+         if (OASIS_debug >= 2) write(nulprt,*) subname,n1,uio
+      endif
+   enddo
+
+   if (.not.found) then
+      write(nulprt,*) subname,' ERROR no unitno available '
+      WRITE(nulprt,*) subname,' abort by model ',compid,' proc :',mpi_rank_local
+      CALL oasis_flush(nulprt)
+      call oasis_abort_noarg()
+   endif
+     
+ END SUBROUTINE oasis_unitget
+
+!==========================================================================
+   SUBROUTINE oasis_unitsetmin(uio)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p),INTENT(in) :: uio
+!--------------------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_unitsetmin'
+!--------------------------------------------------------------------
+
+   maxion = uio
+   if (OASIS_debug >= 20) write(nulprt,*) subname,maxion
+     
+ END SUBROUTINE oasis_unitsetmin
+
+!==========================================================================
+   SUBROUTINE oasis_unitfree(uio)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p),INTENT(in) :: uio
+!--------------------------------------------------------------------
+   INTEGER(kind=ip_intwp_p) :: n1
+   character(len=*),parameter :: subname = 'oasis_unitfree'
+!--------------------------------------------------------------------
+
+   do n1 = 1,muni
+      if (unitno(n1) == uio) then
+         unitno(n1) = -1
+         if (OASIS_debug >= 20) write(nulprt,*) subname,n1,uio
+      endif
+   enddo
+
+ END SUBROUTINE oasis_unitfree
+
+!=========================================================================
+!==========================================================================
+SUBROUTINE oasis_debug_enter(string)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   CHARACTER(len=*), INTENT(in) :: string
+   character(len=*),parameter :: subname = 'oasis_debug_enter'
+   CHARACTER(len=1), pointer :: ch_blank(:)
+   CHARACTER(len=500) :: tree_enter
+
+   if (OASIS_debug >= 10) then
+       ALLOCATE (ch_blank(tree_indent))
+       ch_blank='-'
+       tree_enter='**** ENTER '//TRIM(string)
+       WRITE(nulprt,*) ch_blank,TRIM(tree_enter)
+       tree_indent = tree_indent + tree_delta
+       DEALLOCATE (ch_blank)
+       CALL oasis_flush(nulprt)
+   endif
+
+ END SUBROUTINE oasis_debug_enter
+
+!==========================================================================
+SUBROUTINE oasis_debug_exit(string)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   CHARACTER(len=*), INTENT(in) :: string
+   character(len=*),parameter :: subname = 'oasis_debug_exit'
+   CHARACTER(len=1), pointer :: ch_blank(:)
+   CHARACTER(len=500)        :: tree_exit
+
+   IF (OASIS_debug >= 10) THEN
+       tree_indent = MAX(0,tree_indent - tree_delta)
+       ALLOCATE (ch_blank(tree_indent))
+       ch_blank='-'
+       tree_exit='**** EXIT  '//TRIM(string)
+       WRITE(nulprt,*) ch_blank,TRIM(tree_exit)
+       DEALLOCATE (ch_blank)
+       CALL oasis_flush(nulprt)
+   ENDIF
+
+ END SUBROUTINE oasis_debug_exit
+
+!==========================================================================
+SUBROUTINE oasis_debug_note(string)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   CHARACTER(len=*), INTENT(in) :: string
+   character(len=*),parameter :: subname = 'oasis_debug_note'
+   CHARACTER(len=1), pointer :: ch_blank(:)
+   CHARACTER(len=500) :: tree_note
+
+   if (OASIS_debug >= 12) then
+       ALLOCATE (ch_blank(tree_indent))
+       ch_blank='-'
+       tree_note='**** NOTE '//TRIM(string)
+       WRITE(nulprt,*) ch_blank,TRIM(tree_note)
+      DEALLOCATE(ch_blank)
+      call oasis_flush(nulprt)
+   endif
+
+ END SUBROUTINE oasis_debug_note
+
+!==========================================================================
+
+END MODULE mod_oasis_sys
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_timer.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_timer.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_timer.F90	(revision 4775)
@@ -0,0 +1,656 @@
+!-----------------------------------------------------------------------
+! Copyright 2010, CERFACS, Toulouse, France.
+! Copyright 2010, DKRZ, Hamburg, Germany.
+! All rights reserved. Use is subject to OASIS4 license terms.
+!-----------------------------------------------------------------------
+!
+! !DESCRIPTION:
+!
+! Module oasis_timer contains functionallity, which can be used to
+! measure the time consumed in specific parts of the code.
+!
+! Available routines:
+!  oasis_timer_init         allocates timers
+!  oasis_timer_start        starts specific timer
+!  oasis_timer_stop         stops specific timer and sums up measured time intervals
+!  oasis_timer_print        root process prints all timers of all processes sharing
+!                            the same mpi communicator provided to oasis_timer_init
+!                            in addition it frees all memory allocated by timers
+!
+!
+! !REVISION HISTORY:
+!
+!   Date      Programmer   Description
+! ----------  ----------   -----------
+! 03.01.11    M. Hanke     created (based on psmile_timer.F90 and
+!                                   prismdrv_timer.F90 from SV and JL)
+! 20.09.11    T. Craig     extended
+! 16.04.13    T. Craig     use mpi comm from mod_oasis_data
+!
+!----------------------------------------------------------------------
+!
+!  $Id: oasis_timer.F90 2849 2011-01-05 08:14:13Z hanke $
+!  $Author: hanke $
+!
+!----------------------------------------------------------------------
+
+module mod_oasis_timer
+
+   use mod_oasis_kinds
+   use mod_oasis_data
+   use mod_oasis_sys
+   use mod_oasis_mpi
+
+   implicit none
+   private
+
+   public oasis_timer_init
+   public oasis_timer_start
+   public oasis_timer_stop
+   public oasis_timer_print
+
+   ! name of the application
+   character (len=ic_med) :: app_name
+
+   ! name of the time statistics file
+   character (len=ic_med) :: file_name
+
+   type timer_details
+      ! label of timer
+      character (len=ic_med) :: label
+      ! wall time values
+      double precision :: start_wtime, end_wtime
+      ! cpu time values
+      double precision :: start_ctime, end_ctime
+      ! is the timer running now
+      character(len=1) :: runflag
+   end type timer_details
+
+   INTEGER :: mtimer 
+   TYPE (timer_details), POINTER :: timer(:)
+   DOUBLE PRECISION, POINTER     :: sum_ctime(:)       ! these values are not part of timer details
+   DOUBLE PRECISION, POINTER     :: sum_wtime(:)       ! because they are later used in an mpi call
+   INTEGER, POINTER              :: TIMER_COUNT(:)     ! number of calls
+
+   integer :: ntimer
+
+   integer :: output_unit = 901
+   logical,save :: single_timer_header
+   character(len=1),parameter :: t_stopped = ' '
+   character(len=1),parameter :: t_running = '*'
+
+   contains
+
+! --------------------------------------------------------------------------------
+
+      subroutine oasis_timer_init (app, file, nt)
+
+         implicit none
+
+         character (len=*), intent (in)   :: app
+         character (len=*), intent (in)   :: file
+         integer          , intent (in)   :: nt
+
+         integer :: ierror,n
+         character(len=*),parameter :: subname = 'oasis_timer_init'
+
+         app_name  = trim (app)
+         file_name = trim (file)
+
+         mtimer = nt
+         ALLOCATE(timer(mtimer))
+         ALLOCATE(sum_ctime(mtimer))
+         ALLOCATE(sum_wtime(mtimer))
+         ALLOCATE(timer_count(mtimer))
+
+         ntimer = 0
+         do n = 1,mtimer
+            timer(n)%label       = ' '
+            timer(n)%start_wtime = 0
+            timer(n)%end_wtime   = 0
+            timer(n)%start_ctime = 0
+            timer(n)%end_ctime   = 0
+            timer(n)%runflag     = t_stopped
+
+            sum_wtime(n)         = 0
+            sum_ctime(n)         = 0
+            timer_count(n)       = 0
+         enddo
+
+         IF ((TIMER_debug == 1) .AND. (mpi_rank_local == 0)) TIMER_Debug=2
+
+         IF (TIMER_Debug >= 2) THEN
+
+                 CALL oasis_unitget(output_unit)
+                 WRITE(file_name,'(a,i4.4)') TRIM(file)//'_',mpi_rank_local
+
+                 OPEN(output_unit, file=TRIM(file_name), form="FORMATTED", &
+                    status="UNKNOWN")
+                 WRITE(output_unit,*) ''
+                 CLOSE(output_unit)
+
+         ENDIF
+
+         single_timer_header = .false.
+
+      end subroutine oasis_timer_init
+
+! --------------------------------------------------------------------------------
+
+      subroutine oasis_timer_start (timer_label, barrier)
+
+         implicit none
+
+         character(len=*), intent (in) :: timer_label
+         logical, intent (in), optional :: barrier
+
+         integer :: ierr
+         integer :: timer_id
+         real :: cpu_time_arg
+         character(len=*),parameter :: subname = 'oasis_timer_start'
+
+         IF (TIMER_Debug >=1) THEN
+         call oasis_timer_c2i(timer_label,timer_id)
+         if (timer_id < 0) then
+            ntimer = ntimer + 1
+            timer_id = ntimer
+            timer(timer_id)%label = trim(timer_label)
+            IF (ntimer+1 > mtimer) THEN
+                WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+                WRITE(nulprt,*) subname,' WARNING timer number exceeded' 
+                WRITE(nulprt,*) subname,' Increase mtimer in mod_oasis_method'
+                CALL oasis_flush(nulprt)
+                CALL oasis_abort_noarg()
+            ENDIF
+         endif
+
+         if (present(barrier)) then
+            if (barrier .and. mpi_comm_local /= MPI_COMM_NULL) then
+               call MPI_BARRIER(mpi_comm_local, ierr)
+            endif
+         endif
+
+         timer(timer_id)%start_wtime = MPI_WTIME()
+         call cpu_time(cpu_time_arg)
+         timer(timer_id)%start_ctime = cpu_time_arg
+         timer_count(timer_id) = timer_count(timer_id) + 1
+         timer(timer_id)%runflag = t_running
+         ENDIF
+
+      end subroutine oasis_timer_start
+
+! --------------------------------------------------------------------------------
+
+      subroutine oasis_timer_stop (timer_label)
+
+         character(len=*), intent (in) :: timer_label
+         real :: cpu_time_arg
+         integer :: timer_id
+         character(len=*),parameter :: subname = 'oasis_timer_stop'
+
+         IF (TIMER_Debug >=1) THEN
+         call oasis_timer_c2i(timer_label,timer_id)
+         if (timer_id < 0) then
+             WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+             WRITE(nulprt,*) subname,' WARNING: timer_label does not exist ',&
+                             TRIM(timer_label)
+             CALL oasis_flush(nulprt)
+             RETURN
+         endif
+
+         if (timer(timer_id)%runflag == t_stopped) then
+             WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local
+             WRITE(nulprt,*) subname,' WARNING timer_id ',timer_id,' not started'
+             CALL oasis_flush(nulprt)
+             RETURN
+         endif
+
+         timer(timer_id)%end_wtime = MPI_WTIME()
+         call cpu_time(cpu_time_arg)
+         timer(timer_id)%end_ctime = cpu_time_arg
+
+         sum_wtime(timer_id) = sum_wtime(timer_id) + &
+                               timer(timer_id)%end_wtime - &
+                               timer(timer_id)%start_wtime
+         sum_ctime(timer_id) = sum_ctime(timer_id) + &
+                               timer(timer_id)%end_ctime - &
+                               timer(timer_id)%start_ctime
+         timer(timer_id)%runflag = t_stopped
+         ENDIF
+
+      end subroutine oasis_timer_stop
+
+! --------------------------------------------------------------------------------
+
+      subroutine oasis_timer_print(timer_label)
+
+         implicit none
+
+         character(len=*), optional, intent(in) :: timer_label
+
+         integer :: timer_id
+         real, allocatable             :: sum_ctime_global_tmp(:,:)
+         double precision, allocatable :: sum_wtime_global_tmp(:,:)
+         integer, allocatable          :: count_global_tmp(:,:)
+         character(len=ic_med), allocatable :: label_global_tmp(:,:)
+         real, allocatable             :: sum_ctime_global(:,:)
+         double precision, allocatable :: sum_wtime_global(:,:)
+         integer, allocatable          :: count_global(:,:)
+         double precision, allocatable :: rarr(:)
+         integer, allocatable          :: iarr(:)
+         character(len=ic_med), allocatable :: carr(:)
+         character(len=ic_med), allocatable :: label_list(:)
+         double precision   :: rval
+         integer            :: ival
+         character(len=ic_med) :: cval
+         logical            :: onetimer
+         logical            :: found
+         integer, parameter :: root = 0
+         integer            :: k, n, m
+         integer            :: nlabels
+         integer            :: ierror
+         integer            :: ntimermax
+         integer            :: pe1,pe2
+         integer            :: minpe,maxpe,mcnt
+         double precision   :: mintime,maxtime,meantime
+         character(len=*),parameter :: subname = 'oasis_timer_print'
+
+         IF (TIMER_Debug < 1) then
+            return
+         ENDIF
+
+         onetimer = .false.
+         if (present(timer_label)) then
+            onetimer = .true.
+            call oasis_timer_c2i(timer_label,timer_id)
+            if (timer_id < 1) then
+                WRITE(nulprt,*) subname,' model :',compid,&
+                                ' proc :',mpi_rank_local
+                WRITE(nulprt,*) subname,' WARNING: invalid timer_label',&
+                                TRIM(timer_label)
+                CALL oasis_flush(nulprt)
+                RETURN
+            endif
+         endif
+
+!-----------------------------------------------------
+! one timer output
+!-----------------------------------------------------
+         if (TIMER_Debug >= 2 .and. onetimer) then
+
+            OPEN(output_unit, file=TRIM(file_name), form="FORMATTED", &
+               status="UNKNOWN", position="APPEND")
+            IF (.NOT.single_timer_header) THEN
+               WRITE(output_unit,'(32x,2(2x,a,5x,a,6x,a,4x))') &
+                  ' wtime ','on pe','count',' ctime ','on pe','count'
+               single_timer_header = .TRUE.
+            ENDIF
+            n = timer_id
+            WRITE(output_unit,'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
+               n, timer(n)%label, timer(n)%runflag, &
+               sum_wtime(n), mpi_rank_local, TIMER_COUNT(n), &
+               sum_ctime(n), mpi_rank_local, TIMER_COUNT(n)
+            CLOSE(output_unit)
+!----------
+            return
+!----------
+         endif
+
+!-----------------------------------------------------
+! local output
+!-----------------------------------------------------
+         IF (TIMER_Debug >= 2) THEN
+            OPEN(output_unit, file=TRIM(file_name), form="FORMATTED", &
+               status="UNKNOWN", position="APPEND")
+
+            WRITE(output_unit,*)''
+            WRITE(output_unit,*)' =================================='
+            WRITE(output_unit,*)' ', TRIM(app_name)
+            WRITE(output_unit,*)' Local processor times '
+            WRITE(output_unit,*)' =================================='
+            WRITE(output_unit,*)''
+
+            do n = 1,ntimer
+               IF (.NOT.single_timer_header) THEN
+                  WRITE(output_unit,'(32x,2(2x,a,5x,a,6x,a,4x))') &
+                     ' wtime ','on pe','count',' ctime ','on pe','count'
+                  single_timer_header = .TRUE.
+               ENDIF
+               WRITE(output_unit,'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
+                  n, timer(n)%label, timer(n)%runflag, &
+                  sum_wtime(n), mpi_rank_local, TIMER_COUNT(n), &
+                  sum_ctime(n), mpi_rank_local, TIMER_COUNT(n)
+            enddo
+
+            CLOSE(output_unit)
+         ENDIF
+
+!-----------------------------------------------------
+! gather global output on mpi_comm_local pes
+!-----------------------------------------------------
+         if (mpi_size_local > 0) then
+
+            call oasis_mpi_max(ntimer,ntimermax,mpi_comm_local,string='ntimer',all=.true.)
+
+            allocate (sum_ctime_global_tmp(ntimermax, mpi_size_local), &
+                      sum_wtime_global_tmp(ntimermax, mpi_size_local), stat=ierror)
+            IF ( ierror /= 0 ) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error sum_global_tmp'
+            allocate (count_global_tmp(ntimermax, mpi_size_local), stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error count_global_tmp'
+            allocate (label_global_tmp(ntimermax, mpi_size_local), stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error label_global_tmp'
+
+            sum_ctime_global_tmp = 0.0
+            sum_wtime_global_tmp = 0.0
+            count_global_tmp = 0
+            label_global_tmp = ' '
+
+            ! gathering of timer values on root process
+
+! tcraig, causes memory failure on corail for some reason
+!            call MPI_Gather(sum_ctime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_ctime_global_tmp(1,1), &
+!                            ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
+!            call MPI_Gather(sum_wtime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_wtime_global_tmp(1,1), &
+!                            ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
+!            call MPI_Gather(count(1), ntimermax, MPI_INTEGER, count_global_tmp(1,1), &
+!                            ntimermax, MPI_INTEGER, root, mpi_comm_local, ierror)
+
+! tcraig, this doesn't work either
+!            allocate(rarr(ntimermax),stat=ierror)
+!            if ( ierror /= 0 ) write(nulprt,*) subname,' WARNING: allocate error rarr'
+!            rarr(1:ntimermax) = sum_ctime(1:ntimermax)
+!            call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_ctime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
+!            rarr(1:ntimermax) = sum_wtime(1:ntimermax)
+!            call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_wtime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
+!            deallocate(rarr,stat=ierror)
+!            if ( ierror /= 0 ) write(nulprt,*) subname,' WARNING: deallocate error rarr'
+!
+!            allocate(iarr(ntimermax),stat=ierror)
+!            if ( ierror /= 0 ) write(nulprt,*) subname,' WARNING: allocate error iarr'
+!            iarr(1:ntimermax) = count(1:ntimermax)
+!            call MPI_Gather(iarr,ntimermax,MPI_INTEGER,count_global_tmp,ntimermax,MPI_INTEGER,root,mpi_comm_local,ierror)
+!            deallocate(iarr,stat=ierror)
+!            if ( ierror /= 0 ) write(nulprt,*) subname,' WARNING: deallocate error iarr'
+
+! tcraig this works but requires lots of gather calls, could be better
+            allocate(rarr(mpi_size_local),iarr(mpi_size_local),carr(mpi_size_local),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error rarr'
+            do n = 1,ntimermax
+               cval = timer(n)%label
+               carr(:) = ' '
+               call MPI_Gather(cval,len(cval),MPI_CHARACTER,carr(1),len(cval),&
+                               MPI_CHARACTER,root,mpi_comm_local,ierror)
+               if (mpi_rank_local == root) then
+                  do m = 1,mpi_size_local
+                     label_global_tmp(n,m) = trim(carr(m))
+                  enddo
+               endif
+
+               rval = sum_ctime(n)
+               call MPI_Gather(rval,1,MPI_DOUBLE_PRECISION,rarr(1),1,MPI_DOUBLE_PRECISION,&
+                               root,mpi_comm_local,ierror)
+               if (mpi_rank_local == root) then
+                  sum_ctime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
+               endif
+
+               rval = sum_wtime(n)
+               call MPI_Gather(rval,1,MPI_DOUBLE_PRECISION,rarr(1),1,MPI_DOUBLE_PRECISION,&
+                               root,mpi_comm_local,ierror)
+               if (mpi_rank_local == root) then
+                  sum_wtime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
+               endif
+
+               ival = timer_count(n)
+               call MPI_Gather(ival,1,MPI_INTEGER,iarr(1),1,MPI_INTEGER,root,&
+                               mpi_comm_local,ierror)
+               if (mpi_rank_local == root) then
+                  count_global_tmp(n,1:mpi_size_local) = iarr(1:mpi_size_local)
+               endif
+            enddo
+            deallocate(rarr,iarr,carr,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error rarr'
+
+            ! now sort all the timers out by names
+
+            allocate(carr(ntimermax*mpi_size_local),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error carr'
+            nlabels = 0
+            do n = 1,ntimermax
+            do m = 1,mpi_size_local
+               found = .false.
+               do k = 1,nlabels
+                  if (trim(label_global_tmp(n,m)) == trim(carr(k))) found = .true.
+                  if (trim(label_global_tmp(n,m)) == '') found = .false.
+               enddo
+               if (.not.found) then
+                  nlabels = nlabels + 1
+                  carr(nlabels) = trim(label_global_tmp(n,m))
+               endif
+            enddo
+            enddo
+
+            allocate(label_list(nlabels),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error label_list'
+            do k = 1,nlabels
+               label_list(k) = trim(carr(k))
+            enddo
+            deallocate(carr,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error carr'
+            allocate(sum_ctime_global(nlabels,mpi_size_local),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error sum_ctime_global'
+            allocate(sum_wtime_global(nlabels,mpi_size_local),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error sum_wtime_global'
+            allocate(count_global(nlabels,mpi_size_local),stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: allocate error count_global'
+
+            sum_ctime_global = 0
+            sum_wtime_global = 0
+            count_global = 0
+
+            do k = 1,nlabels
+            do m = 1,ntimermax
+            do n = 1,mpi_size_local
+               if (trim(label_list(k)) == trim(label_global_tmp(m,n))) then
+                  sum_ctime_global(k,n) = sum_ctime_global_tmp(m,n)
+                  sum_wtime_global(k,n) = sum_wtime_global_tmp(m,n)
+                  count_global(k,n) = count_global_tmp(m,n)
+               endif
+            enddo
+            enddo
+            enddo
+
+            deallocate(label_global_tmp,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error label_global_tmp'
+            deallocate(sum_ctime_global_tmp,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error sum_ctime_global_tmp'
+            deallocate(sum_wtime_global_tmp,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error sum_wtime_global_tmp'
+            deallocate(count_global_tmp,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error count_global'
+
+         endif ! (mpi_size_local > 1)
+
+!-----------------------------------------------------
+! write global output on root of mpi_comm_local 
+!-----------------------------------------------------
+         if (TIMER_Debug >= 2 .and. mpi_rank_local == root) then
+            OPEN(output_unit, file=TRIM(file_name), form="FORMATTED", &
+               status="UNKNOWN", position="APPEND")
+
+            if (onetimer) then
+               IF (.NOT.single_timer_header) THEN
+                  WRITE(output_unit,'(32x,2(2x,a,5x,a,6x,a,4x))') &
+                     'mintime','on pe','count','maxtime','on pe','count'
+                  single_timer_header = .TRUE.
+               ENDIF
+               n = 0
+               do k = 1,nlabels
+                  if (trim(timer_label) == trim(label_list(k))) n = k
+               enddo
+               if (n < 1) then
+                  write(nulprt,*) subname,' model :',compid,' proc :',&
+                  mpi_rank_local,':',' WARNING: invalid timer_label',trim(timer_label)
+                  CALL oasis_flush(nulprt)
+                  return
+               endif
+               mintime = sum_ctime_global(n,1)
+               minpe = 1
+               maxtime = sum_ctime_global(n,1)
+               maxpe = 1
+               do k = 1,mpi_size_local
+                  if (sum_ctime_global(n,k) < mintime) then
+                     mintime = sum_ctime_global(n,k)
+                     minpe = k
+                  endif
+                  if (sum_ctime_global(n,k) > maxtime) then
+                     maxtime = sum_ctime_global(n,k)
+                     maxpe = k
+                  endif
+               enddo
+               WRITE(output_unit,'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
+                  n, label_list(n), timer(n)%runflag, &
+                  sum_ctime_global(n,minpe), minpe, count_global(n,minpe), &
+                  sum_ctime_global(n,maxpe), maxpe, count_global(n,maxpe)
+
+            else
+               single_timer_header = .FALSE.
+
+               WRITE(output_unit,*)''
+               WRITE(output_unit,*)' =================================='
+               WRITE(output_unit,*)' ', TRIM(app_name)
+               WRITE(output_unit,*)' Overall Elapsed Min/Max statistics'
+               WRITE(output_unit,*)' =================================='
+               WRITE(output_unit,*)''
+               WRITE(output_unit,'(32x,2(2x,a,5x,a,6x,a,4x),a,3x)') &
+                  'mintime','on pe','count','maxtime','on pe','count','meantime'
+
+               DO n = 1,nlabels
+                  mintime = 1.0e36
+                  minpe = -1
+                  maxtime = -1.0e36
+                  maxpe = -1
+                  meantime = 0.0
+                  mcnt = 0
+                  do k = 1,mpi_size_local
+                     if (count_global(n,k) > 0) then
+                        meantime = meantime + sum_wtime_global(n,k)
+                        mcnt = mcnt + 1
+                        if (sum_wtime_global(n,k) < mintime) then
+                           mintime = sum_wtime_global(n,k)
+                           minpe = k
+                        endif
+                        if (sum_wtime_global(n,k) > maxtime) then
+                           maxtime = sum_wtime_global(n,k)
+                           maxpe = k
+                        endif
+                     endif
+                  enddo
+                  if (mcnt > 0) meantime = meantime / float(mcnt)
+                  WRITE(output_unit,'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x),f10.4)') &
+                     n, label_list(n), timer(n)%runflag, &
+                     sum_wtime_global(n,minpe), minpe-1, count_global(n,minpe), &
+                     sum_wtime_global(n,maxpe), maxpe-1, count_global(n,maxpe), &
+                     meantime
+               ENDDO
+
+               IF (TIMER_Debug >= 3) THEN
+                  WRITE(output_unit,*)''
+                  WRITE(output_unit,*)' =================================='
+                  WRITE(output_unit,*)' ', TRIM(app_name)
+                  WRITE(output_unit,*)' Overall Count statistics'
+                  WRITE(output_unit,*)' =================================='
+                  WRITE(output_unit,*)''
+                  DO k=1,mpi_size_local
+                     WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r    ----------> "
+                     WRITE(output_unit,'(3x,i8,5x)')(k-1)
+                     DO n = 1, nlabels
+                        WRITE(output_unit,'(1x,i8,2x,a24,a1,1x,(i10))') n, label_list(n), &
+                                          timer(n)%runflag, (count_global(n,k))
+                     ENDDO
+                  ENDDO
+                  WRITE(output_unit,*)''
+                  WRITE(output_unit,*)' =================================='
+                  WRITE(output_unit,*)' ', TRIM(app_name)
+                  WRITE(output_unit,*)' Overall CPU time statistics'
+                  WRITE(output_unit,*)' =================================='
+                  WRITE(output_unit,*)''
+                  DO k=1,mpi_size_local
+                     WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r    ----------> "
+                     WRITE(output_unit,'(3x,i8,5x)')(k-1)
+                     DO n = 1, nlabels
+                        WRITE(output_unit,'(1x,i8,2x,a24,a1,1x,(f10.4))') n, label_list(n), timer(n)%runflag, &
+                                         (sum_ctime_global(n,k))
+                     ENDDO
+                  ENDDO
+                  WRITE(output_unit,*)''
+                  WRITE(output_unit,*)' ======================================'
+                  WRITE(output_unit,*)' ', TRIM(app_name)
+                  WRITE(output_unit,*)' Overall Elapsed time statistics'
+                  WRITE(output_unit,*)' ======================================'
+                  WRITE(output_unit,*)''
+                  DO k=1,mpi_size_local
+                     WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r    ----------> "
+                     WRITE(output_unit,'(3x,i8,5x)')(k-1)
+                     DO n = 1, nlabels
+                        WRITE(output_unit,'(1x,i8,2x,a24,a1,1x,(f10.4))') n, label_list(n), timer(n)%runflag, &
+                                           (sum_wtime_global(n,k))
+                     ENDDO
+                  ENDDO
+                  WRITE(output_unit,*)''
+                  WRITE(output_unit,*)' ======================================'
+               ENDIF
+
+            endif ! (onetimer)
+
+            CLOSE(output_unit)
+
+            deallocate (sum_ctime_global, stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error sum_ctime_global'
+            deallocate (sum_wtime_global, stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error sum_wtime_global'
+            deallocate (count_global,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error count_global'
+            deallocate (label_list,stat=ierror)
+            if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
+               mpi_rank_local,':',' WARNING: deallocate error label_list'
+
+         endif ! (mpi_rank_local == root)
+
+
+      end subroutine oasis_timer_print
+
+! --------------------------------------------------------------------------------
+      subroutine oasis_timer_c2i(tname,tid)
+
+         character(len=*),intent(in)  :: tname
+         integer         ,intent(out) :: tid
+
+         integer :: n
+
+         tid = -1
+         do n = 1,ntimer
+            if (trim(tname) == trim(timer(n)%label)) tid = n
+         enddo
+
+      end subroutine oasis_timer_c2i
+
+! --------------------------------------------------------------------------------
+end module mod_oasis_timer
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_var.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_var.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_oasis_var.F90	(revision 4775)
@@ -0,0 +1,113 @@
+  MODULE mod_oasis_var
+
+  USE mod_oasis_kinds
+  USE mod_oasis_data
+  USE mod_oasis_parameters
+  USE mod_oasis_sys
+
+  IMPLICIT none
+
+  private
+
+  !--- interfaces ---
+  public oasis_def_var
+
+  !--- datatypes ---
+
+  integer(kind=ip_intwp_p),public :: prism_nvar = 0
+
+  CONTAINS
+
+!---------------------------------------------------------------
+
+  SUBROUTINE oasis_def_var(id_nports, cdport, id_part, &
+         id_var_nodims, kinout, id_var_shape, ktype, kinfo)
+!    ---------------------------------------------------------------
+     INTEGER(kind=ip_i4_p) :: kinout, ktype, id_nports,id_part
+     INTEGER(kind=ip_i4_p) :: id_var_nodims(2),id_var_shape(2*id_var_nodims(1))
+     CHARACTER(len=*)         :: cdport
+     INTEGER(kind=ip_i4_p),optional :: kinfo
+!    ---------------------------------------------------------------
+     INTEGER(kind=ip_i4_p) :: n
+     character(len=*),parameter :: subname = 'oasis_def_var'
+     LOGICAL    :: l_field_in_namcouple
+!    ---------------------------------------------------------------
+
+     call oasis_debug_enter(subname)
+
+     kinfo = OASIS_Ok
+
+     l_field_in_namcouple = .FALSE.
+     do n = 1,mvar
+        if (trim(cdport) == trim(total_namsrcfld(n)) .OR. trim(cdport) == trim(total_namdstfld(n))) &
+       &       l_field_in_namcouple = .TRUE.
+     enddo
+
+     if (.not. l_field_in_namcouple) then
+        id_nports = OASIS_Var_Uncpl
+        if (OASIS_debug >= 2) then
+           write(nulprt,*) subname,' variable not in namcouple return ',trim(cdport)
+           call oasis_flush(nulprt)
+        endif
+        call oasis_debug_exit(subname)
+        return
+     endif
+
+
+     do n = 1,prism_nvar
+        if (trim(cdport) == trim(prism_var(n)%name)) then
+           write(nulprt,*) subname,' variable already defined with var_def ',trim(cdport)
+           WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+           CALL oasis_flush(nulprt)
+           call oasis_abort_noarg()
+        endif
+     enddo
+
+     prism_nvar = prism_nvar + 1
+     id_nports = prism_nvar
+
+
+     if (prism_nvar > mvar) then
+        write(nulprt,*) subname,' ERROR prism_nvar too large ',prism_nvar,mvar
+        WRITE(nulprt,*) subname,' abort by model :',compid,' proc :',mpi_rank_local
+        CALL oasis_flush(nulprt)
+        call oasis_abort_noarg()
+     endif
+
+     prism_var(prism_nvar)%name = trim(cdport)
+     prism_var(prism_nvar)%part = id_part
+     prism_var(prism_nvar)%ndim = id_var_nodims(1)
+     prism_var(prism_nvar)%num  = id_var_nodims(2)
+     prism_var(prism_nvar)%ops  = kinout
+     prism_var(prism_nvar)%type = ktype
+     prism_var(prism_nvar)%size = 1
+     do n = 1,prism_var(prism_nvar)%ndim
+        prism_var(prism_nvar)%size = prism_var(prism_nvar)%size*(id_var_shape(2*n)-&
+                                     id_var_shape(2*n-1)+1)
+     enddo
+     prism_var(prism_nvar)%ncpl = 0
+     prism_var(prism_nvar)%cpl  = 0
+
+    !----------------------------------
+    !--- some diagnostics
+    !----------------------------------
+     if (OASIS_debug >= 2) then
+        write(nulprt,*) ' '
+        write(nulprt,*) subname,' prism_nvar    = ',prism_nvar
+        write(nulprt,*) subname,' varname = ',prism_nvar,trim(prism_var(prism_nvar)%name)
+        write(nulprt,*) subname,' varpart = ',prism_nvar,prism_var(prism_nvar)%part
+        write(nulprt,*) subname,' varndim = ',prism_nvar,prism_var(prism_nvar)%ndim
+        write(nulprt,*) subname,' varnum  = ',prism_nvar,prism_var(prism_nvar)%num
+        write(nulprt,*) subname,' varops  = ',prism_nvar,prism_var(prism_nvar)%ops
+        write(nulprt,*) subname,' vartype = ',prism_nvar,prism_var(prism_nvar)%type
+        write(nulprt,*) subname,' varsize = ',prism_nvar,prism_var(prism_nvar)%size
+        write(nulprt,*) ' '
+        CALL oasis_flush(nulprt)
+     endif
+
+     call oasis_debug_exit(subname)
+
+   END SUBROUTINE oasis_def_var
+
+ END MODULE mod_oasis_var
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_prism.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_prism.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/psmile/src/mod_prism.F90	(revision 4775)
@@ -0,0 +1,53 @@
+module mod_prism
+
+! !USES:
+   use mod_oasis_kinds  ,only: ip_single_p
+   use mod_oasis_kinds  ,only: ip_double_p
+   use mod_oasis_kinds  ,only: ip_realwp_p
+   use mod_oasis_kinds  ,only: ll_single
+   use mod_oasis_kinds  ,only: ip_i2_p
+   use mod_oasis_kinds  ,only: ip_i4_p
+   use mod_oasis_kinds  ,only: ip_i8_p
+   use mod_oasis_kinds  ,only: ip_intwp_p
+
+   use mod_oasis_parameters
+
+   USE mod_oasis_namcouple ,ONLY: namflddti
+
+   USE mod_oasis_auxiliary_routines ,ONLY: prism_get_ncpl_proto      => oasis_get_ncpl
+   USE mod_oasis_auxiliary_routines ,ONLY: prism_get_freqs_proto     => oasis_get_freqs      
+   USE mod_oasis_auxiliary_routines ,ONLY: prism_put_inquire_proto   => oasis_put_inquire
+
+   use mod_oasis_method ,only: prism_init_comp_proto                 => oasis_init_comp
+   use mod_oasis_method ,only: prism_terminate_proto                 => oasis_terminate
+   use mod_oasis_method ,only: prism_get_localcomm_proto             => oasis_get_localcomm
+   use mod_oasis_method ,only: prism_set_couplcomm                   => oasis_set_couplcomm
+   use mod_oasis_method ,only: prism_create_couplcomm                => oasis_create_couplcomm
+   use mod_oasis_method ,only: prism_get_intracomm                   => oasis_get_intracomm
+   use mod_oasis_method ,only: prism_get_intercomm                   => oasis_get_intercomm 
+   use mod_oasis_method, only: prism_set_debug                       => oasis_set_debug 
+   use mod_oasis_method, only: prism_get_debug                       => oasis_get_debug
+   use mod_oasis_method ,only: prism_enddef_proto                    => oasis_enddef
+
+   use mod_oasis_part   ,only: prism_def_partition_proto             => oasis_def_partition 
+
+   use mod_oasis_var    ,only: prism_def_var_proto                   => oasis_def_var
+
+   use mod_oasis_getput_interface ,only: prism_get_proto             => oasis_get
+   use mod_oasis_getput_interface ,only: prism_put_proto             => oasis_put
+
+   use mod_oasis_grid   ,only: prism_start_grids_writing             => oasis_start_grids_writing
+   use mod_oasis_grid   ,only: prism_write_grid                      => oasis_write_grid 
+   USE mod_oasis_grid   ,ONLY: prism_write_angle                     => oasis_write_angle
+   use mod_oasis_grid   ,only: prism_write_corner                    => oasis_write_corner 
+   use mod_oasis_grid   ,only: prism_write_mask                      => oasis_write_mask
+   use mod_oasis_grid   ,only: prism_write_area                      => oasis_write_area
+   use mod_oasis_grid   ,only: prism_terminate_grids_writing         => oasis_terminate_grids_writing
+
+   use mod_oasis_sys    ,only: prism_abort_proto                     => oasis_abort
+
+   implicit none
+
+!===============================================================================
+
+end module mod_prism
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/Makefile
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/Makefile	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/Makefile	(revision 4775)
@@ -0,0 +1,66 @@
+
+SRCS1 =  $(shell ls $(COUPLE)/lib/scrip/src/*.F90)
+OBJS1 =  $(patsubst $(COUPLE)/lib/scrip/src/%.F90, %.o, $(SRCS1))
+
+SRCS3   = $(shell ls $(COUPLE)/lib/scrip/src/*.F)
+OBJS3   = $(patsubst $(COUPLE)/lib/scrip/src/%.F, %.o, $(SRCS3))
+
+SRCS4 =  $(shell ls $(COUPLE)/lib/scrip/src/*.f)
+OBJS4 =  $(patsubst $(COUPLE)/lib/scrip/src/%.f, %.o, $(SRCS4))
+
+VPATH =	.:$(COUPLE)/lib/scrip/src:$(COUPLE)/src
+
+LIBRARY	= $(ARCHDIR)/lib/libscrip.a
+
+clean:
+	rm -f i.* *.o *.mod
+
+all:	$(LIBRARY)
+
+$(LIBRARY): $(OBJS1)  $(OBJS3) $(OBJS4)
+	$(AR) $(ARFLAGS) $(LIBRARY) $(OBJS1) $(OBJS3) $(OBJS4)
+
+.SUFFIXES:
+.SUFFIXES: .o .f .F .f90 .F90 .c
+
+%.o: %.F90
+	$(F90) $(F90FLAGS) -c   $<
+
+%.o: %.f90
+	$(f90) $(f90FLAGS) -c   $<
+
+%.o: %.F
+	$(F) $(FFLAGS) -c   $<
+
+%.o: %.f
+	$(f) $(fFLAGS) -c   $<
+
+%.o: %.c
+	$(CC) $(CCFLAGS) -c   $<
+
+#
+# ALL dependencies ...
+#
+mod_oasis_flush.o : kinds_mod.o
+remap_bicubic_reduced.o: constants.o grids.o remap_vars.o
+netcdf.o: constants.o kinds_mod.o 
+remap_conserv.o: constants.o grids.o kinds_mod.o remap_vars.o timers.o
+remap_distwgt.o: constants.o grids.o kinds_mod.o remap_vars.o
+remap_vars.o: constants.o grids.o kinds_mod.o
+scrip.o: constants.o grids.o iounits.o kinds_mod.o remap_bicubic.o \
+	remap_bicubic_reduced.o remap_bilinear.o remap_bilinear_reduced.o \
+	remap_conserv.o remap_distwgt.o remap_gauswgt.o remap_vars.o \
+	remap_write.o timers.o
+constants.o: kinds_mod.o
+distance.o: constants.o kinds_mod.o
+fracnnei.o: constants.o grids.o kinds_mod.o remap_vars.o 
+gradient_bicubic.o: constants.o kinds_mod.o 
+grids.o: constants.o iounits.o kinds_mod.o 
+iounits.o: kinds_mod.o 
+kinds_mod.o: 
+remap_bicubic.o: constants.o grids.o kinds_mod.o remap_vars.o
+remap_bilinear.o: constants.o grids.o kinds_mod.o remap_vars.o
+remap_bilinear_reduced.o: constants.o grids.o kinds_mod.o remap_vars.o
+remap_gauswgt.o: constants.o grids.o kinds_mod.o remap_vars.o
+remap_write.o: constants.o grids.o kinds_mod.o netcdf.o remap_vars.o 
+timers.o: kinds_mod.o
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/constants.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/constants.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/constants.f	(revision 4775)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f 818 2006-03-10 17:18:31Z valcke $
+!
+!     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.14159265358979323846_dbl_kind,
+     &                        pi2    = two*pi,
+     &                        pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/distance.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/distance.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/distance.f	(revision 4775)
@@ -0,0 +1,83 @@
+       FUNCTION distance (lon1, lat1, lon2, lat2)
+C****
+C               *****************************
+C               * OASIS ROUTINE  -  LEVEL ? *
+C               * -------------     ------- *
+C               *****************************
+C
+C**** *distance*  - calculate the distance between two points on a sphere
+C
+C     Purpose:
+C     -------
+C     Calculation of the distance between two points on a sphere
+C       1. Transformation to x,y,z-coordinates
+C       2. Calculating the distance
+C       3. Calculating the distance on the sphere
+C
+C**   Interface:
+C     ---------
+C       *CALL*  *distance*(lon1, lat1, lon2, lat2)
+C
+C     Input:
+C     -----
+C          lon1              : longitude of first point (rad)
+C          lat1              : latitude of first point (rad)
+C          lon2              : longitude of second point (rad)
+C          lat2              : latitude of second point (rad)
+C
+C     Output:
+C     ------
+C          distance          : distance
+CC
+C     History:
+C     -------
+C       Version   Programmer     Date        Description
+C       -------   ----------     ----        -----------  
+C       2.5       V. Gayler      2001/09/20  created
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      USE constants
+      USE kinds_mod
+
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+!     INTENT(IN)
+!-----------------------------------------------------------------------
+      REAL (kind=real_kind), INTENT(IN) :: 
+     $     lon1,                ! longitude of first point (rad)
+     $     lon2,                ! longitude of second point (rad)
+     $     lat1,                ! latitude of first point (rad)
+     $     lat2                 ! latitude of second point (rad)
+
+!-----------------------------------------------------------------------
+!     LOKAL VARIABLES
+!-----------------------------------------------------------------------
+      REAL (kind=real_kind) ::
+     $     x1, y1, z1,          ! coordinates of the first point
+     $     x2, y2, z2,          ! coordinates of the second point
+     $     distance             ! distance between the points (rad)
+
+!-----------------------------------------------------------------------
+
+!     Transformation to x,y,z-coordinates
+!     -----------------------------------
+      x1 = cos(lat1)*cos(lon1)
+      y1 = cos(lat1)*sin(lon1)
+      z1 = sin(lat1)
+
+      x2 = cos(lat2)*cos(lon2)
+      y2 = cos(lat2)*sin(lon2)
+      z2 = sin(lat2)
+
+!     Calculation of the distance
+!     ---------------------------
+!     direct distance:
+      distance = SQRT((x2-x1)**2 + (y2-y1)**2 + (z2-z1)**2)
+
+!     distance along the surface:
+      distance = 2*ASIN(distance/2)
+
+!-----------------------------------------------------------------------
+      RETURN 
+      END FUNCTION distance
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/fracnnei.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/fracnnei.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/fracnnei.f	(revision 4775)
@@ -0,0 +1,275 @@
+      subroutine fracnnei (src_size, dst_size,
+     $    ld_srcmask, ld_dstmask,
+     $    src_lon, src_lat, dst_lon, dst_lat,
+     $    num_links, num_wgts,
+     $    weights, src_addr, dst_addr)
+C****
+C               *****************************
+C               * OASIS ROUTINE  -  LEVEL 4 *
+C               * -------------     ------- *
+C               *****************************
+C
+C**** *fracnnei* - SCRIP remapping
+C
+C     Purpose:
+C     -------
+C     Treatment of the tricky points in an interpolation
+C
+C     Interface:
+C     ---------
+C       *CALL*  *
+C
+C     Called from:
+C     -----------
+C     scriprmp
+C
+C     Input:
+C     -----
+C             src_size    : source grid size (integer)
+C             dst_size    : target grid size (integer)
+C             ld_srcmask  : mask of the source grid
+C             ld_dstmask  : mask of the target grid
+C             src_lon     : longitudes of the source grid
+C             src_lat     : latitudes of the source grid
+C             dst_lon     : longitudes of the target grid
+C             dst_lat     : latitudes of the target grid
+C             num_links   : total number of links
+C             num_wgts    : number of weights for each link
+C     InOut
+C     -----
+C             weights     : remapping weights
+C             src_addr    : remapping source addresses
+C             dst_addr    : remapping target addresses
+C
+C     History:
+C     -------
+C       Version   Programmer     Date        Description
+C       -------   ----------     ----        -----------  
+C       2.5       D.Declat       2002/08/20  adapted from S. Valcke ptmsq
+C       3.0       S. Valcke      2002/10/30  test and corrections
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+C* ---------------------------- Modules used ----------------------------
+C
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      USE mod_oasis_flush
+C
+C* ---------------------------- Implicit --------------------------------
+C
+      implicit none
+C
+C* ---------------------------- Include files ---------------------------
+C
+
+C      INCLUDE 'netcdf.inc'
+C
+C* ---------------------------- Intent In -------------------------------
+C
+      INTEGER (kind=int_kind) ::
+     $    src_size,             ! size of the source grid
+     $    dst_size              ! size of the destination grid
+C
+      REAL (kind=dbl_kind) ::
+     $    src_lat(src_size), src_lon(src_size),
+     $    dst_lat(dst_size), dst_lon(dst_size)
+
+C
+      LOGICAL ::
+     $    ld_srcmask(src_size),   ! source grid mask
+     $    ld_dstmask(dst_size)    ! target grid mask
+C
+      INTEGER (kind=int_kind) ::
+     $    num_links,      ! number of links between src and tgt
+     $    num_wgts        ! number of weights
+
+C
+C* ---------------------------- Intent InOut ------------------------------
+C
+      REAL (kind=dbl_kind) ::
+     $    weights(num_wgts, num_links) ! remapping weights
+C
+      INTEGER (kind=int_kind) ::
+     $    src_addr(num_links), ! remapping source addresses
+     $    dst_addr(num_links)  ! remapping target addresses
+C
+C* ---------------------------- Local declarations ----------------------
+C
+C
+      INTEGER (kind=int_kind) :: 
+     $    ila_nneiadd           ! Nearest-neighbor address
+C
+      INTEGER (kind=int_kind) ::
+     $    ib_dst,               ! INDEX loop for the distance grid
+     $    ib_src,               ! INDEX loop for the source grid
+     $    ib_neigh,             ! INDEX loop on the corresponding src pts
+     $    ib_links              ! INDEX loop for the links      
+C
+      INTEGER (kind=int_kind) ::
+     $    nb_Vmm,               ! number of Mtt points
+     $    ntottotland,          ! number of land points
+     $    ntotland,             ! number of land points
+     $    ntotoce,              ! number of oceanic points
+     $    ntotngh               ! number of corresponding source points
+C
+      INTEGER (kind=int_kind) ::
+     $    beg_links,            ! begining of the serie of links
+     $    nb_links              ! number of links
+C
+      REAL (kind=dbl_kind) ::
+     $    coslat,               ! cosinus of the latitude
+     $    sinlat,               ! sinus of the latitude
+     $    coslon,               ! cosinus of the longitude
+     $    sinlon,               ! sinus of the longitude
+     $    distance, 
+     $    dist_min,
+     $    arg
+C
+      INTEGER (kind=int_kind) :: n, il
+C
+C* ---------------------------- Poema verses ----------------------------
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+C
+C*    1. Initialization
+C        --------------
+C
+      IF (nlogprt .GE. 2) THEN
+          WRITE (UNIT = nulou,FMT = *) ' '
+          WRITE (UNIT = nulou,FMT = *) ' '
+          WRITE (UNIT = nulou,FMT = *) 
+     $        '   Entering ROUTINE fracnnei  -  Level 4'
+          WRITE (UNIT = nulou,FMT = *) 
+     $        '           ****************     *******'
+          WRITE (UNIT = nulou,FMT = *) ' '
+          WRITE (UNIT = nulou,FMT = *) 
+     $        ' Treating the tricky points of the remapping'
+          WRITE (UNIT = nulou,FMT = *) ' '
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+C
+C *----------------------------------------------------------------------
+C
+C*    2. Treating Vmm points   V
+C        -------------------  m m
+C     The target point is a non-masked Valid point while the source points 
+C         are all masked points. Use of the non-masked nearest neighbours.
+C
+      nb_Vmm = 0
+      ntottotland = 0
+      beg_links = 1
+
+C* -- Loop all other the target points
+      DO ib_dst = 1, dst_size
+C* -- If the point is a sea point
+        IF (ld_dstmask(ib_dst)) THEN
+
+            beg_links = 0
+
+            DO ib_links = 1, num_links
+              IF (dst_addr(ib_links) .eq. ib_dst) THEN
+                  beg_links = ib_links
+                  exit
+              ENDIF
+            END DO 
+
+            IF (beg_links .ne. 0) THEN
+
+                ntotland = 0
+                ntotoce = 0
+                ntotngh = 0
+
+C* -- Find the number of associated src points to the non-masked tgt point
+                nb_links = 1
+                DO il = beg_links+1, num_links
+                  IF (dst_addr(il) .eq. dst_addr(beg_links)) 
+     $                nb_links = nb_links + 1
+                END DO
+                
+C* -- For each point on the src grid associated to the non-masked tgt point
+                DO ib_neigh = 1, nb_links
+C
+                  ntotngh = ntotngh + 1
+
+C* -- Check IF the point is a masked or non-masked point and treat it
+                  IF (.not. ld_srcmask(src_addr(beg_links+ib_neigh-1)))
+     $                THEN
+                      ntotland = ntotland + 1
+                      ntottotland = ntottotland + 1
+                  ELSE IF (ld_srcmask(src_addr(beg_links+ib_neigh-1))) 
+     $                    THEN
+                      ntotoce = ntotoce + 1
+                  ELSE
+                      WRITE (nulou, *) 'Pb with ocean mask with Mtt 1' 
+                  END IF
+
+                END DO
+ 
+C* -- If all the src points are land, treat it !
+                IF (ntotland .EQ. ntotngh) THEN
+                    nb_Vmm = nb_Vmm + 1
+                    WRITE(nulou,*) 
+     $               '************ Doing FRACNNEI for point', ib_dst  
+
+C* -- Find the nearest neighbours and change weights and address 
+
+                    coslat = cos(dst_lat(ib_dst))
+                    sinlat = sin(dst_lat(ib_dst))
+                    coslon = cos(dst_lon(ib_dst))
+                    sinlon = sin(dst_lon(ib_dst))
+
+                    dist_min = bignum
+                    ila_nneiadd = 0
+                    DO ib_src = 1, src_size
+                      IF (ld_srcmask(ib_src)) THEN
+                          arg = 
+     &                        coslat*cos(src_lat(ib_src))*
+     &                       (coslon*cos(src_lon(ib_src)) +
+     &                        sinlon*sin(src_lon(ib_src)))+
+     &                        sinlat*sin(src_lat(ib_src))
+                          IF (arg < -1.0d0) THEN
+                              arg = -1.0d0
+                          ELSE IF (arg > 1.0d0) THEN
+                              arg = 1.0d0
+                          END IF
+                          distance = acos(arg)
+                          IF (distance < dist_min) THEN
+                              ila_nneiadd = ib_src
+                              dist_min = distance
+                          ENDIF
+                      ENDIF
+                    END DO
+                    src_addr(beg_links) = ila_nneiadd
+                    weights(1,beg_links) = 1.0
+                    WRITE(nulou,*) 
+     $               '*************** Nearest source neighbour is ', 
+     $                  ila_nneiadd                    
+                    IF (nb_links > 1) then
+                        DO n=2, nb_links
+                          src_addr(beg_links+n-1)=0
+                          weights(1,beg_links+n-1)=0.0
+                        END DO
+                    END IF
+                END IF
+            END IF
+        ENDIF
+      END DO
+C
+C
+C *----------------------------------------------------------------------
+C
+      IF (nlogprt .GE. 2) THEN
+          WRITE (UNIT = nulou,FMT = *) ' '
+          WRITE (UNIT = nulou,FMT = *) 
+     $        '   Leaving ROUTINE fracnnei  -  Level 4'
+          WRITE (UNIT = nulou,FMT = *) ' '
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+
+      END SUBROUTINE fracnnei
+
+!***********************************************************************
+
+  
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/grids.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/grids.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/grids.f	(revision 4775)
@@ -0,0 +1,812 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C****
+C***********************************************************************
+C     This module belongs to the SCRIP library. It is modified to run
+C     within OASIS. 
+C     Modifications:
+C       - routine does not read SCRIP grid description files, but gets 
+C         arrays from the calling routine
+C       - unit conversion : only from degrees (OASIS unit) to radians
+C       - some allocated array will be freed in the end to allow multiple
+C         calls of SCRIP
+C       - map-methods and restriction-types are written in capital letters
+C       - added bin definition for reduced grid
+C
+C     Modified by            V. Gayler,  M&D                  20.09.2001
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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 mod_oasis_flush
+
+      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
+     &        num_srch_red    ! num of bins for reduced case
+
+      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
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        bin_addr1_r  ! min,max adds for red grid1 cells
+
+      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
+      real(kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &        bin_lats_r ! min,max lat for each search bin for red grid
+     &,       bin_lons_r ! min,max lon for each search bin for red grid
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(m_method, rst_type, n_srch_bins,
+     $                     src_size, dst_size, src_dims, dst_dims, 
+     &                     src_rank, dst_rank, ncrn_src, ncrn_dst,
+     &                     src_mask, dst_mask, src_name, dst_name,
+     &                     src_lat,  src_lon,  dst_lat,  dst_lon,
+     &                     src_corner_lat, src_corner_lon,
+     &                     dst_corner_lat, dst_corner_lon, 
+     &                     logunit)
+
+!-----------------------------------------------------------------------
+!
+!     this routine gets grid info from routine scriprmp and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     n_srch_bins,         ! num of bins for restricted srch
+     &     src_size,            ! source grid size
+     &     dst_size,            ! target grid size
+     &     src_rank,            ! source grid rank
+     &     dst_rank,            ! target grid rank
+     &     src_dims(src_rank),  ! source grid dimensions
+     &     dst_dims(dst_rank),  ! target grid dimensions
+     &     ncrn_src,            ! number of corners of a source grid cell
+     &     ncrn_dst,            ! number of corners of a target grid cell
+     &     src_mask(src_size),  ! source grid mask (master mask)
+     &     dst_mask(dst_size)   ! target grid mask 
+
+      integer(kind=int_kind), intent(in), optional ::
+     &     logunit
+
+      character*8, intent(in) ::
+     &     m_method,            ! remapping method
+     &     rst_type,            ! restriction type
+     &     src_name,            ! source grid name
+     &     dst_name             ! target grid name
+
+      real (kind=real_kind), intent (in) ::
+     &     src_lat(src_size), ! source grid latitudes
+     &     src_lon(src_size), ! sourde grid longitudes
+     &     dst_lat(dst_size),   ! target grid latitudes
+     &     dst_lon(dst_size),   ! target grid longitudes
+     &     src_corner_lat(ncrn_src,src_size), 
+     &     src_corner_lon(ncrn_src,src_size), 
+     &     dst_corner_lat(ncrn_dst,dst_size), 
+     &     dst_corner_lon(ncrn_dst,dst_size) 
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: 
+     &  n      ! loop counter
+     &, nele   ! element loop counter
+     &, i,j    ! logical 2d addresses
+     &, ip1,jp1
+     &, n_add, e_add, ne_add
+     &, nx, ny
+
+      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
+      character(len=*),parameter :: subname = 'scrip:grid_init '
+!
+!-----------------------------------------------------------------------
+!
+      if (present(logunit)) then
+         nulou = logunit
+      endif
+
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine grid_init'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+!      write(nulou,*) subname,trim(m_method)
+!      write(nulou,*) subname,src_size,dst_size,src_rank,dst_rank
+
+      select case(m_method)
+      case ('CONSERV')
+        luse_grid_centers = .false.
+      case ('BILINEAR')
+        luse_grid_centers = .true.
+      case ('BICUBIC')
+        luse_grid_centers = .true.
+      case ('DISTWGT')
+        luse_grid_centers = .true.
+      case ('GAUSWGT')
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      allocate( grid1_mask      (src_size),
+     &          grid2_mask      (dst_size),
+     &          grid1_center_lat(src_size), 
+     &          grid1_center_lon(src_size),
+     &          grid2_center_lat(dst_size), 
+     &          grid2_center_lon(dst_size),
+     &          grid1_area      (src_size),
+     &          grid2_area      (dst_size),
+     &          grid1_frac      (src_size),
+     &          grid2_frac      (dst_size),
+     &          grid1_dims      (src_rank),
+     &          grid2_dims      (dst_rank),
+     &          grid1_bound_box (4       , src_size),
+     &          grid2_bound_box (4       , dst_size))
+
+      if (.not. luse_grid_centers) then
+        allocate( grid1_corner_lat(ncrn_src, src_size),
+     &            grid1_corner_lon(ncrn_src, src_size),
+     &            grid2_corner_lat(ncrn_dst, dst_size),
+     &            grid2_corner_lon(ncrn_dst, dst_size))
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     copy input data to module data
+!
+!-----------------------------------------------------------------------
+
+      restrict_type    = rst_type
+      num_srch_bins    = n_srch_bins
+      grid1_size       = src_size
+      grid2_size       = dst_size
+      grid1_dims       = src_dims
+      grid2_dims       = dst_dims 
+      grid1_rank       = src_rank
+      grid2_rank       = dst_rank
+      grid1_corners    = ncrn_src
+      grid2_corners    = ncrn_dst
+      grid1_name       = src_name
+      grid2_name       = dst_name
+      grid1_center_lat = src_lat
+      grid1_center_lon = src_lon
+      grid2_center_lat = dst_lat
+      grid2_center_lon = dst_lon
+
+      if (.not. luse_grid_centers) then
+        grid1_corner_lat = src_corner_lat
+        grid1_corner_lon = src_corner_lon
+        grid2_corner_lat = dst_corner_lat
+        grid2_corner_lon = dst_corner_lon
+      endif
+
+c      if (luse_grid1_area) then
+c        grid1_area_in
+c      endif
+c      if (luse_grid2_area) then
+c        grid2_area_in
+c      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+      where (src_mask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+
+      where (dst_mask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+
+C
+C* -- convert unit from degrees (OASIS unit) to radians
+C
+      grid1_center_lat = grid1_center_lat*deg2rad
+      grid1_center_lon = grid1_center_lon*deg2rad
+      grid2_center_lat = grid2_center_lat*deg2rad
+      grid2_center_lon = grid2_center_lon*deg2rad
+
+      if (.not. luse_grid_centers) then
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      endif
+
+      grid1_units='radians'
+      grid2_units='radians'
+!-----------------------------------------------------------------------
+!
+!     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
+
+      if (.not. luse_grid_centers) then
+        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
+      endif
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+
+      if (.not. luse_grid_centers) then
+        where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+        where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+        where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+        where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     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(nulou,*) '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(nulou,*) '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 ('REDUCED')
+        write(nulou,*) 
+     &  '|  Using reduced bins to restrict search. Reduced grids with'
+        write(nulou,*) 
+     &  '| a maximum of 500*NBRBINS latitude circles can be treated'
+
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+        allocate(bin_addr1_r(4,500*num_srch_bins))
+        allocate(bin_lats_r (2,500*num_srch_bins))
+        allocate(bin_lons_r (2,500*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_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        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
+
+
+        bin_addr1_r(1,1) = 0
+        bin_lats_r(1,1) = grid1_center_lat(1)
+        num_srch_red = 1
+        do nele=1,grid1_size-1
+          if (grid1_center_lat(nele+1) ==  
+     &        grid1_center_lat(nele)) THEN
+              bin_addr1_r(2,num_srch_red) = nele+1
+          else IF (grid1_center_lat(nele+1) /=  
+     &        grid1_center_lat(nele)) THEN 
+              bin_addr1_r(1,num_srch_red+1) = nele+1
+              bin_lats_r(2,num_srch_red) = grid1_center_lat(nele+1)
+              bin_lats_r(1,num_srch_red+1) = 
+     &            bin_lats_r(2,num_srch_red)
+              num_srch_red = num_srch_red+1
+          ENDIF
+        end DO
+        
+        DO nele = 1,num_srch_red-1
+          bin_addr1_r(3,nele)=bin_addr1_r(1,nele+1)
+          bin_addr1_r(4,nele)=bin_addr1_r(2,nele+1)
+        enddo
+        bin_addr1_r(3,num_srch_red) = bin_addr1_r(1,num_srch_red-1)
+        bin_addr1_r(4,num_srch_red) = bin_addr1_r(2,num_srch_red-1)
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine grid_init'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+! 
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      subroutine free_grids
+
+!-----------------------------------------------------------------------
+!
+!     subroutine to deallocate allocated arrays
+!
+!----------------------------------------------------------------------- 
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine free_grid'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+! 
+      deallocate(grid1_mask, grid2_mask, 
+     &    grid1_center_lat, grid1_center_lon,
+     &    grid2_center_lat, grid2_center_lon,
+     &    grid1_area, grid2_area,
+     &    grid1_frac, grid2_frac,
+     &    grid1_dims, grid2_dims)
+
+      IF (restrict_TYPE == 'REDUCED') then
+          deallocate( grid1_bound_box, grid2_bound_box,
+     &        bin_addr1_r, bin_addr2,
+     &        bin_lons, bin_lats,
+     &        bin_lats_r, bin_lons_r)
+      else
+          deallocate( grid1_bound_box, grid2_bound_box,
+     &        bin_addr1, bin_addr2,
+     &        bin_lats, bin_lons)
+      endif
+
+      if (.not. luse_grid_centers) then
+        deallocate(grid1_corner_lat, grid1_corner_lon,
+     &             grid2_corner_lat, grid2_corner_lon)
+      ENDIF
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine free_grid'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!-----------------------------------------------------------------------
+
+      end subroutine free_grids
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/iounits.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/iounits.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/iounits.f	(revision 4775)
@@ -0,0 +1,183 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      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 (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine get_unit'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      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
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine get_unit'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      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
+!
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine release_unit'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine release_unit'
+         WRITE (UNIT = nulou,FMT = *)' '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/kinds_mod.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/kinds_mod.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/kinds_mod.f	(revision 4775)
@@ -0,0 +1,82 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f 818 2006-03-10 17:18:31Z valcke $
+!
+!     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
+      integer, parameter :: int_kind  = SELECTED_INT_KIND(9)
+      integer, parameter :: log_kind  = kind(.true.)
+      integer, parameter :: real_kind = SELECTED_REAL_KIND(12,307)
+      integer, parameter :: dbl_kind  = SELECTED_REAL_KIND(12,307)
+!-----------------------------------------------------------------------
+! hardwire for now, tcraig
+
+      INTEGER           :: nlogprt = 2
+      INTEGER           :: nulou = 6
+      logical,parameter :: ll_single = .false.   ! single reals
+      logical,parameter :: lncdfgrd = .true.     ! grid files netcdf
+      integer,parameter :: jpeight = 8
+      character(len=*),parameter :: cgrdnam = 'grids'
+      character(len=*),parameter :: cglonsuf  = '.lon'
+      character(len=*),parameter :: cglatsuf  = '.lat'
+      character(len=*),parameter :: crnlonsuf = '.clo'
+      character(len=*),parameter :: crnlatsuf = '.cla'
+
+      INTEGER, DIMENSION (:), ALLOCATABLE :: snum_links, snum_wgts
+      LOGICAL, DIMENSION (:), ALLOCATABLE :: sweight_flag
+
+      TYPE wp
+         REAL(kind=dbl_kind), POINTER :: warray(:,:)
+      END TYPE wp
+      type(wp), allocatable :: sweigth(:)
+
+      TYPE sp
+        INTEGER, POINTER :: srcarray(:)
+      END TYPE sp
+      type(sp), allocatable :: ssrc_addr(:)
+
+      TYPE dp
+        INTEGER, POINTER :: dstarray(:)
+      END TYPE dp
+      type(dp), allocatable :: sdst_addr(:)
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/mod_oasis_flush.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/mod_oasis_flush.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/mod_oasis_flush.F90	(revision 4775)
@@ -0,0 +1,32 @@
+MODULE mod_oasis_flush
+
+  USE kinds_mod     ! defines common data types
+  !
+  IMPLICIT NONE
+
+   private
+
+   public oasis_flush_scrip
+
+!--------------------------------------------------------------------
+CONTAINS
+!--------------------------------------------------------------------
+
+!==========================================================================
+   SUBROUTINE oasis_flush_scrip(nu)
+
+   IMPLICIT NONE
+
+!--------------------------------------------------------------------
+   INTEGER(kind=int_kind),INTENT(in) :: nu
+!--------------------------------------------------------------------
+   character(len=*),parameter :: subname = 'oasis_flush_scrip'
+!--------------------------------------------------------------------
+
+   CALL FLUSH(nu)
+
+ END SUBROUTINE oasis_flush_scrip
+
+!==========================================================================
+
+END MODULE mod_oasis_flush
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/netcdf.F
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/netcdf.F	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/netcdf.F	(revision 4775)
@@ -0,0 +1,79 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.F 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+        WRITE(nulou,*)'Error in netCDF: ',nf_strerror(istat)
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic.f	(revision 4775)
@@ -0,0 +1,781 @@
+C****
+C               *****************************
+C               * OASIS MODULE  -  LEVEL ? *
+C               * -------------     ------- *
+C               *****************************
+C
+C**** remap_bilinear - calculate bilinear remapping
+C
+C     Purpose:
+C     -------
+C     Adaptation of SCRIP 1.4 remap_bicubic module to calculate 
+C     bicubic remapping.
+C
+C**   Interface:
+C     ---------
+C       *CALL*  *remap_bicub**
+C
+C     Input:
+C     -----
+C
+C     Output:
+C     ------
+C
+C     History:
+C     -------
+C       Version   Programmer     Date        Description
+C       -------   ----------     ----        -----------  
+C       2.5       S. Valcke      2002/09     Treatment for masked point
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      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 (lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+      LOGICAL :: lextrapdone   ! logical, true if EXTRAP done on field
+      LOGICAL :: ll_nnei       ! true (default) if extra search is done
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,i, 
+     &     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  corners
+     &     src_lons        ! longitudes of four  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 bicubic 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
+
+      real (kind=dbl_kind) ::  
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance, ! for computing dist-weighted avg
+     &      src_latsnn, arg
+
+      integer (kind=int_kind) :: min_add, max_add, srch_add, src_addnn
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine remap_bicub'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      ll_nnei = .true.
+      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,
+     &                         min_add, max_add,
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, 
+     &                         lextrapdone)
+
+        if (src_add(1) > 0) then
+
+          !***
+          !*** if the 4 surrounding points have been found and are 
+          !*** non-masked, do bicubic interpolation
+          !***
+
+          grid2_frac(dst_add) = one
+
+          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
+              WRITE (UNIT = nulou,FMT = *)
+     &            'Iteration for i,j exceed max iteration count'
+              STOP
+          endif
+
+        else if (src_add(1) < 0) THEN
+
+          !***
+          !*** Search for bicubic failed or at least one of the 4
+          !*** neighbours was masked. Do distance-weighted average using
+          !*** the non-masked points among the 4 closest ones. 
+          !***
+
+
+          IF (nlogprt .eq. 2) then
+              WRITE(nulou,*) ' '
+              WRITE(nulou,*) 
+     &  'WARNING: Cannot make bicubic interpolation for target point'
+     &            ,dst_add
+              WRITE(nulou,*) 
+     &    'Using non-masked points among 4 nearest neighbors.'
+              WRITE(nulou,*) ' '
+          ENDIF
+
+          !***
+          !*** Find the 4 closest points
+          !***
+          coslat_dst = cos(plat)
+          sinlat_dst = sin(plat)
+          coslon_dst = cos(plon)
+          sinlon_dst = sin(plon)
+          src_add = 0
+          dist_min = bignum
+          src_lats = bignum
+          do srch_add = min_add,max_add
+            arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &           (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &            sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &            sinlat_dst*sin(grid1_center_lat(srch_add))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF               
+            distance=acos(arg)
+            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
+
+          !***
+          !*** Among 4 closest points, keep only the non-masked ones
+          !***
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n)) .or.
+     &          (.not. grid1_mask(src_add(n)) .and. lextrapdone)) 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,:) = 0.
+              wgts(3,:) = 0.
+              wgts(4,:) = 0.
+
+              grid2_frac(dst_add) = one
+              call store_link_bicub(dst_add, src_add, wgts, nmap)
+          ELSE
+              IF (ll_nnei .eqv. .true. ) then
+              IF (NLOGPRT .GE. 2) THEN
+                  WRITE(nulou,*) '  '
+                  WRITE(nulou,*)' Using the nearest non-masked neighbour
+     & as all 4 surrounding source points are masked for target point',
+     &                dst_add
+                  WRITE(nulou,*) 'with longitude and latitude', 
+     &                plon, plat
+              ENDIF
+              src_latsnn = bignum
+!cdir novector
+              do srch_add = min_add,max_add
+                if (grid1_mask(srch_add) .or.
+     &          (.not. grid1_mask(srch_add) .and. lextrapdone)) THEN
+                    arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &                   (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &                    sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &                    sinlat_dst*sin(grid1_center_lat(srch_add))
+                    IF (arg < -1.0d0) THEN
+                        arg = -1.0d0
+                    ELSE IF (arg > 1.0d0) THEN
+                        arg = 1.0d0
+                    END IF                    
+                    distance=acos(arg)
+
+                    if (distance < src_latsnn) then
+                        src_addnn = srch_add
+                        src_latsnn = distance
+                    endif
+                endif
+              end DO
+              IF (NLOGPRT .GE. 2) THEN
+                  WRITE(nulou,*) '  '
+                  WRITE(nulou,*) 
+     &                'Nearest non masked neighbour is source point ',
+     &                src_addnn
+                  WRITE(nulou,*) 'with longitude and latitude',
+     &          grid1_center_lon(src_addnn), grid1_center_lat(src_addnn)
+              ENDIF
+!
+              wgts(1,1) = 1.
+              wgts(1,2:4) = 0.
+              wgts(2,:) = 0.
+              wgts(3,:) = 0.
+              wgts(4,:) = 0.
+              src_add(1) = src_addnn
+              src_add(2) = 0
+              src_add(3) = 0
+              src_add(4) = 0
+
+              grid2_frac(dst_add) = one
+              call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+       ENDIF
+      ENDIF
+      end do grid_loop1
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine remap_bicub'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons, 
+     &                             min_add, max_add,
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_bound_box,
+     &                             src_bin_add, lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      integer (kind=int_kind) :: min_add, max_add
+    
+!-----------------------------------------------------------------------
+!
+!     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
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add, ni,  ! dummy indices
+     &    nx, ny, ntotmask,           ! dimensions of src grid
+     &    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
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+        !*** first check bounding box
+
+        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
+          
+          !*** find ip1
+          !*** Note: I do not want to take into account the number
+          !*** of overlapping grid points, as the underlying cell
+          !*** will be found in all cases if the grid overlaps.
+
+          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 
+            !*** 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
+              
+              ! Check if one point is masked; IF so, nearest-neighbour
+              ! interpolation will be used
+  
+              ntotmask = 0
+              do ni=1,4
+                if (.not. grid1_mask(src_add(ni)).and. 
+     &              .not. lextrapdone) 
+     &              ntotmask = ntotmask + 1 
+              end DO
+              IF (ntotmask .gt. 0) src_add(1) = -src_add(1)  
+      
+              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. Put src_add = -1 so that
+      !*** distance-weighted average of the 4 non-masked closest points
+      !*** is done in calling routine.
+  
+      src_add = -1
+
+!-----------------------------------------------------------------------
+
+      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: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic_reduced.F90
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic_reduced.F90	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bicubic_reduced.F90	(revision 4775)
@@ -0,0 +1,1116 @@
+MODULE remap_bicubic_reduced
+
+!-----------------------------------------------------------------------
+! BOP
+!
+! !MODULE: remap_bicubic_reduced
+! 
+! !USES:
+  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
+  USE mod_oasis_flush
+
+! !PUBLIC TYPES:
+  IMPLICIT NONE  
+! !PUBLIC MEMBER FUNCTIONS:
+!  
+! !PUBLIC DATA MEMBERS:
+ 
+! !DESCRIPTION:
+!  This routine computes the weights for a bicubic interpolation
+!  with a reduced grid. Computes mappings from grid1 to grid2.
+!
+! !REVISION HISTORY:
+!  2002.10.21  J.Ghattas  created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------
+  
+
+
+CONTAINS
+  
+!***********************************************************************
+  
+    
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE:  remap_bicub_reduced
+!
+! !INTERFACE:
+
+  SUBROUTINE remap_bicub_reduced(ld_extrapdone)
+      
+! !USES:
+    
+! !RETURN VALUE:
+    
+! !PARAMETERS:
+
+    LOGICAL, INTENT(in) :: &
+       ld_extrapdone              ! logical, true if EXTRAP done on field
+    LOGICAL :: ll_nnei            ! true (default) if extra search is done 
+    
+    INTEGER (KIND=int_kind), DIMENSION(4,4) :: &
+       ila_src_add                ! address for source points non-masked  
+    
+    INTEGER (KIND=int_kind), DIMENSION(4) :: &
+       ila_nbr_found              ! nrb of points found on each latitude
+    
+    INTEGER (KIND=int_kind) :: &
+       ib_i, &                    ! iter index
+       ib_dst_add, &              ! destination address, target point
+       il_count, &                ! nbr of latitudes with found points   
+       il_min, il_max, bin        ! begin and end for distances calculation
+    
+    REAL (KIND=dbl_kind), DIMENSION(4,4) :: &
+       rla_src_lons, &            ! longitudes for the points 'ila_src_add'
+       rla_weight, &              ! bicubic weights for the points 'ila_src_add'
+       rla_wght_lon               ! temp. weights
+    
+    REAL (KIND=dbl_kind), DIMENSION(4) :: &
+       rla_src_lats, &            ! latitudes for the points 'ila_src_add'
+       rla_lats_temp, &           ! temp. latitudes
+       rla_wght_lat, rla_wght_temp! temp. weights
+    
+    REAL (KIND=dbl_kind) :: &
+       rl_plat, rl_plon         ! latitude and longitude for destination address
+    
+    REAL (KIND=dbl_kind) :: &     ! variables for distances calculation
+       rl_coslat_dst, rl_sinlat_dst, &
+       rl_coslon_dst, rl_sinlon_dst, &
+       rl_distance, arg           
+
+    REAL (KIND=dbl_kind), DIMENSION(2) :: &
+       rla_dist                   ! lat distances to point cible     
+
+    INTEGER (KIND=int_kind), DIMENSION(4) :: &
+       ila_add_dist               ! temporary addr. for distances       
+
+    LOGICAL :: ll_linear          ! flag
+
+    
+! !DESCRIPTION:
+!  This routine computes the weights for a bicubic interpolation
+!  with a reduced grid. Computes mappings from grid1 to grid2.     
+! 
+! !REVISION HISTORY:
+!  2002.10.21  J.Ghattas   created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *) 'Entering routine remap_bicub_reduced'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!   
+      ll_nnei = .true.
+    !
+    !  Loop over destination grid     
+    !
+
+    DO ib_dst_add = 1, grid2_size ! for each target point
+      ll_linear=.false.
+      IF (.NOT. grid2_mask(ib_dst_add)) THEN
+	  CYCLE      ! target point is masked
+      END IF
+      
+      rl_plat = grid2_center_lat(ib_dst_add)
+      rl_plon = grid2_center_lon(ib_dst_add)
+      
+
+      !
+      !   Search for non-masked points among the closest 16 points 
+      !   on source grid (grid1)
+      !
+
+      CALL grid_search_16_points(ila_src_add,   rla_src_lats, rla_src_lons,&
+	                         ila_nbr_found, bin,          rl_plat, &
+				 rl_plon,       ld_extrapdone)
+    
+		      
+      !
+      ! If there is no point found, search the neaerst 
+      ! non-masked point
+      !
+
+      IF (SUM(ila_nbr_found)==0) THEN
+          IF (ll_nnei .EQV. .TRUE. ) THEN
+          IF (nlogprt .GE. 2) THEN
+              WRITE(nulou,*) '  '
+              WRITE(nulou,*) &
+                 'All 16 surrounding source grid points are masked'
+              WRITE(nulou,*) 'for target point ',ib_dst_add
+              WRITE(nulou,*) 'with longitude and latitude', rl_plon, rl_plat
+              WRITE(nulou,*) 'Using the nearest non-masked neighbour.' 
+              WRITE(nulou,*) ' '
+              CALL OASIS_FLUSH_SCRIP(nulou)
+          ENDIF
+          
+          ! Search the nearest point in bin [il_min:il_max]
+	  IF (bin==0 .or. bin==1) THEN
+	      il_min=1
+	      il_max=bin_addr1_r(2,3)
+	  ELSE IF (bin==num_srch_red .or. bin==num_srch_red-1) THEN
+	      il_min=bin_addr1_r(1,num_srch_red-2)
+	      il_max=bin_addr1_r(2,num_srch_red)
+	  ELSE
+	      il_min=bin_addr1_r(1,bin-1)+1
+	      il_max=bin_addr1_r(2,bin+2)
+	  END IF
+	 
+	  rl_coslat_dst = COS(rl_plat)
+	  rl_sinlat_dst = SIN(rl_plat)
+	  rl_coslon_dst = COS(rl_plon)
+	  rl_sinlon_dst = SIN(rl_plon)
+	  
+	  rla_weight(1,1) = bignum
+	  ila_src_add(1,1) = 0
+!cdir novector
+	  DO ib_i=il_min, il_max		 	   
+	    IF (grid1_mask(ib_i) .or. ld_extrapdone) THEN
+                arg = rl_coslat_dst*COS(grid1_center_lat(ib_i))* &
+		     (rl_coslon_dst*COS(grid1_center_lon(ib_i)) + &
+		      rl_sinlon_dst*SIN(grid1_center_lon(ib_i)))+&
+		      rl_sinlat_dst*SIN(grid1_center_lat(ib_i))
+                IF (arg < -1.0d0) THEN
+                    arg = -1.0d0
+                ELSE IF (arg > 1.0d0) THEN
+                    arg = 1.0d0
+                END IF
+		rl_distance = ACOS(arg)
+		IF (rl_distance < rla_weight(1,1)) THEN
+		    rla_weight(1,1) = rl_distance
+		    ila_src_add(1,1) = ib_i
+		END IF
+	    END IF
+	  END DO
+	  rla_weight(:,:) = 0
+	  rla_weight(1,1) = 1
+	  
+	  CALL store_link_bicub(ib_dst_add, ila_src_add, rla_weight)
+          IF (nlogprt .GE. 2) THEN
+              WRITE(nulou,*)  &
+                 'Nearest non masked neighbour is source point ', &
+                 ila_src_add(1,1)
+              WRITE(nulou,*) 'with longitude and latitude', &
+                 grid1_center_lon(ila_src_add(1,1)), &
+                 grid1_center_lat(ila_src_add(1,1)) 
+              WRITE(nulou,*) '  '
+          ENDIF
+          CYCLE 
+      ENDIF
+      END IF
+
+      rla_weight(:,:) = 0
+      ! if there is only one point found, save it
+      IF (SUM(ila_nbr_found)==1) THEN   
+	  DO ib_i=1,4
+	    IF (ila_nbr_found(ib_i)==1) THEN
+		rla_weight(ib_i,1)=1
+		EXIT
+	    END IF
+	  END DO
+	  CALL store_link_bicub(ib_dst_add, ila_src_add, rla_weight)
+	  CYCLE
+      END IF
+
+      ! if there are only 2 points found, distance weighted average 
+      IF (SUM(ila_nbr_found)==2) THEN
+	  rl_coslat_dst = COS(rl_plat)
+	  rl_sinlat_dst = SIN(rl_plat)
+	  rl_coslon_dst = COS(rl_plon)
+	  rl_sinlon_dst = SIN(rl_plon)
+	  		    
+	  rl_distance=0  ! count of total distance 
+	  DO ib_i=1,4
+	    IF (ila_nbr_found(ib_i) > 0) THEN
+                arg = rl_coslat_dst*COS(rla_src_lats(ib_i))* &
+		     (rl_coslon_dst*COS(rla_src_lons(ib_i,1)) + &
+		      rl_sinlon_dst*SIN(rla_src_lons(ib_i,1)))+&
+		      rl_sinlat_dst*SIN(rla_src_lats(ib_i))
+                IF (arg < -1.0d0) THEN
+                    arg = -1.0d0
+                ELSE IF (arg > 1.0d0) THEN
+                    arg = 1.0d0
+                END IF
+		rla_weight(ib_i,1) = ACOS(arg)
+		rl_distance = rl_distance+rla_weight(ib_i,1)
+		IF (ila_nbr_found(ib_i)==2) THEN
+                    arg = rl_coslat_dst*COS(rla_src_lats(ib_i))* &
+		       (rl_coslon_dst*COS(rla_src_lons(ib_i,2)) + &
+		       rl_sinlon_dst*SIN(rla_src_lons(ib_i,2)))+&
+		       rl_sinlat_dst*SIN(rla_src_lats(ib_i))
+                    IF (arg < -1.0d0) THEN
+                        arg = -1.0d0
+                    ELSE IF (arg > 1.0d0) THEN
+                        arg = 1.0d0
+                    END IF
+		    rla_weight(ib_i,2) =  ACOS(arg)
+		    rl_distance = rl_distance+rla_weight(ib_i,2)
+		END IF
+	    END IF
+	  END DO
+	  rla_weight=rla_weight/rl_distance
+
+	  CALL store_link_bicub(ib_dst_add, ila_src_add, rla_weight)
+	  CYCLE
+      END IF
+      
+      ! Some case exceptional when just one point per line found 
+      
+      IF (ila_nbr_found(1)==1) THEN  ! elimination of point
+	  ila_nbr_found(1)=0
+	  ila_src_add(1,1)=0
+      END IF
+      IF (ila_nbr_found(4)==1) THEN 
+	  ila_nbr_found(4)=0
+	  ila_src_add(4,1)=0
+      END IF
+      
+     
+
+      IF (ila_nbr_found(2)==1 .or. ila_nbr_found(3)==1) THEN
+	  ila_add_dist(:)=4
+	  rla_dist(:)=bignum
+
+	  ! search for the 2 nearest points or line of points
+	  DO ib_i=1,4
+	    IF (ila_nbr_found(ib_i) > 1) THEN
+		rl_distance=ABS(rla_src_lats(ib_i)-rl_plat)		
+	    ELSE IF (ila_nbr_found(ib_i)==1) THEN
+		rl_coslat_dst = COS(rl_plat)
+		rl_sinlat_dst = SIN(rl_plat)
+		rl_coslon_dst = COS(rl_plon)
+		rl_sinlon_dst = SIN(rl_plon)
+                arg = rl_coslat_dst*COS(rla_src_lats(ib_i))* &
+		     (rl_coslon_dst*COS(rla_src_lons(ib_i,1)) + &
+		      rl_sinlon_dst*SIN(rla_src_lons(ib_i,1)))+&
+		      rl_sinlat_dst*SIN(rla_src_lats(ib_i)) 
+                IF (arg < -1.0d0) THEN
+                    arg = -1.0d0
+                ELSE IF (arg > 1.0d0) THEN
+                    arg = 1.0d0
+                END IF
+		rl_distance= ACOS(arg)
+	    ELSE
+		rl_distance=bignum
+	    END IF
+
+	    IF (rl_distance < rla_dist(1)) THEN
+		ila_add_dist(2)=ila_add_dist(1)
+		ila_add_dist(1)=ib_i
+		rla_dist(2)=rla_dist(1)
+		rla_dist(1)=rl_distance
+	    ELSE IF (rl_distance < rla_dist(2)) THEN
+		ila_add_dist(2)=ib_i
+		rla_dist(2)=rl_distance
+	    END IF
+	  END DO
+
+	  IF (ila_nbr_found(ila_add_dist(1))>1 .and. &
+	     ila_nbr_found(ila_add_dist(2))>1) THEN
+	      ! linearie
+	      ll_linear=.true.	     
+	  ELSE 
+              ! do distance weighted averege
+	      rla_wght_lon(:,:)=0
+	      DO ib_i=1,2
+		SELECT CASE (ila_nbr_found(ila_add_dist(ib_i)))
+		CASE (4)
+		    CALL calcul_wght_irreg(rla_src_lons(ila_add_dist(ib_i),:),&
+		       rl_plon, rla_wght_lon(ila_add_dist(ib_i),:))	
+		    rla_wght_lon(ila_add_dist(ib_i),:)=&
+		       rla_wght_lon(ila_add_dist(ib_i),:)/& 
+		       rla_dist(ib_i)
+		CASE (3)
+		    CALL calcul_wght_3(rla_src_lons(ila_add_dist(ib_i),1:3),&
+		       rl_plon, rla_wght_lon(ila_add_dist(ib_i),1:3))
+		    rla_wght_lon(ila_add_dist(ib_i),1:3)=&
+		       rla_wght_lon(ila_add_dist(ib_i),1:3)/& 
+		       rla_dist(ib_i)
+		CASE (2)	    
+		    CALL calcul_wght_2(rla_src_lons(ila_add_dist(ib_i),1:2),&
+		       rl_plon, rla_wght_lon(ila_add_dist(ib_i),1:2))
+		    rla_wght_lon(ila_add_dist(ib_i),1:2)=&
+		       rla_wght_lon(ila_add_dist(ib_i),1:2)/& 
+		       rla_dist(ib_i)
+		CASE (1)
+		    rla_wght_lon(ila_add_dist(ib_i),1)=1/rla_dist(ib_i)
+		END SELECT
+	      END DO
+	      rl_distance=0
+	      DO ib_i=1,4
+		rl_distance=rl_distance + sum(rla_wght_lon(ib_i,:))
+	      END DO
+	      rla_weight(:,:)=rla_wght_lon(:,:)/rl_distance
+
+	      CALL store_link_bicub(ib_dst_add, ila_src_add , rla_weight)
+	      CYCLE
+	  END IF
+      END IF
+
+      !
+      ! Calculation of weights for longitudes
+      !  
+     
+      rla_wght_lon(:,:)=0       
+      DO ib_i=1,4                         
+	SELECT CASE (ila_nbr_found(ib_i))
+	CASE (4)	      
+	    CALL calcul_wght_irreg(rla_src_lons(ib_i,:), rl_plon, &
+	       rla_wght_lon(ib_i,:))
+	CASE (3)
+	    CALL calcul_wght_3(rla_src_lons(ib_i,1:3), rl_plon, &
+	       rla_wght_lon(ib_i,1:3))
+	CASE (2)	    
+	    CALL calcul_wght_2(rla_src_lons(ib_i,1:2), rl_plon, &
+	       rla_wght_lon(ib_i,1:2))	
+	END SELECT	
+      END DO
+
+
+      IF (ll_linear) THEN
+	  rla_wght_lat(:)=0	 
+	  CALL calcul_wght_2(rla_src_lats(ila_add_dist(:)), rl_plat, &
+	     rla_wght_temp(1:2))
+	  rla_wght_lat(ila_add_dist(1))=rla_wght_temp(1)
+	  rla_wght_lat(ila_add_dist(2))=rla_wght_temp(2)
+	  DO ib_i=1,4
+	    rla_weight(ib_i,:)=rla_wght_lat(ib_i)*rla_wght_lon(ib_i,:)
+	  END DO
+	  
+	  CALL store_link_bicub(ib_dst_add, ila_src_add , rla_weight)
+	  CYCLE
+      END IF
+    
+
+      !
+      ! Calculation of weights for latitudes
+      !
+	
+      il_count=0
+      DO ib_i=1,4
+	IF (ila_nbr_found(ib_i)/=0) THEN
+	    il_count=il_count+1
+	    rla_lats_temp(il_count)=rla_src_lats(ib_i)
+	END IF
+      END DO
+      
+      SELECT CASE (il_count)
+      CASE (4)   	   
+	  CALL calcul_wght_irreg(rla_lats_temp, rl_plat, rla_wght_temp(:))
+      CASE (3)
+	  CALL calcul_wght_3(rla_lats_temp(1:3), rl_plat, rla_wght_temp(1:3))
+      CASE (2)
+	  CALL calcul_wght_2(rla_lats_temp(1:2), rl_plat, rla_wght_temp(1:2))
+      CASE (1)
+	  rla_wght_temp(1)=1
+      END SELECT
+      
+      il_count=0
+      DO ib_i=1,4
+	IF (ila_nbr_found(ib_i)/=0) THEN
+	    il_count=il_count+1
+	    rla_wght_lat(ib_i)=rla_wght_temp(il_count)
+	ELSE
+	    rla_wght_lat(ib_i)=0
+	END IF
+      END DO
+      
+      ! 
+      ! Calculation of total weight, elementwise multiplication
+      !
+	
+      DO ib_i=1,4
+	rla_weight(ib_i,:)=rla_wght_lat(ib_i)*rla_wght_lon(ib_i,:)
+      END DO     
+      
+      CALL store_link_bicub(ib_dst_add, ila_src_add , rla_weight)
+
+    END DO
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *) 'Leaving routine remap_bicub_reduced'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!          
+  END SUBROUTINE remap_bicub_reduced
+    
+    
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE: grid_search_16_points
+!
+! !INTERFACE:
+!  
+  SUBROUTINE grid_search_16_points(ida_src_add,   rda_src_lats, rda_src_lons,&
+                                   ida_nbr_found, bin,          rd_plat, &
+				   rd_plon,       ld_extrapdone)
+!    
+! !USES:
+!  
+! !RETURN VALUE:
+!    
+    INTEGER (KIND=int_kind), DIMENSION(4,4), INTENT(out) :: &
+       ida_src_add    ! searched addresses of the unmasked points enclosing
+                      ! target point
+      
+    REAL (KIND=dbl_kind), DIMENSION(4,4), INTENT(out) :: &
+       rda_src_lons   ! longitudes of the searched points
+
+    REAL (KIND=dbl_kind), DIMENSION(4), INTENT(out) :: &
+       rda_src_lats   ! latitudes  of the searched points 
+    
+    INTEGER (KIND=int_kind), DIMENSION(4), INTENT(out) :: &
+       ida_nbr_found  ! indicates for each line how many points found
+    
+    INTEGER (KIND=int_kind), INTENT(out) :: &
+       bin            ! actual bin for target point
+!    
+! !PARAMETERS:
+!  
+    REAL (KIND=dbl_kind), INTENT(in) :: &
+       rd_plat, &     ! latitude  of the target point
+       rd_plon      ! longitude of the target point
+          
+    LOGICAL, INTENT(in) :: ld_extrapdone ! true if extrapolation done
+    
+    INTEGER (KIND=int_kind) :: &
+       ib_k, ib_j, ib_i, &        ! iteration indices
+       il_min, il_max, il_inter   ! begin and end for actual bin
+    
+    INTEGER (KIND=int_kind), DIMENSION(4,2) :: &
+       ila_corners                ! temp addresses for bins   
+                       
+!
+! !DESCRIPTION:   
+!  This routine finds the location of the target point in the source
+!  grid and returns those of the 16 nearest points that are unmasked.
+!  The source grid is a reduced grid. 
+!
+! !REVISION HISTORY:
+!  2002.10.21  J.Ghattas   created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------   
+      
+     
+    !
+    ! serch of actual bin
+    !
+     
+    
+    IF (rd_plat > bin_lats_r(1,1)) THEN ! norther of the first bin
+	bin=0
+	ila_corners(1:2,1:2)= 0	  
+	ila_corners(3,1)= bin_addr1_r(1,1)+1
+	ila_corners(3,2)= bin_addr1_r(2,1)
+	ila_corners(4,1)= bin_addr1_r(1,2)
+	ila_corners(4,2)= bin_addr1_r(2,2)
+	
+    ELSE IF (rd_plat > bin_lats_r(1,2)) THEN ! in the first bin
+	bin=1
+	ila_corners(1,1:2)= 0
+	ila_corners(2,1)= bin_addr1_r(1,1)+1
+	ila_corners(2,2)= bin_addr1_r(2,1)
+	ila_corners(3,1)= bin_addr1_r(1,2)
+	ila_corners(3,2)= bin_addr1_r(2,2)
+	ila_corners(4,1)= bin_addr1_r(1,3)  
+	ila_corners(4,2)= bin_addr1_r(2,3)
+		
+    ELSE IF (rd_plat < bin_lats_r(1,num_srch_red)) THEN 
+        ! South of the last complet bin
+	bin=num_srch_red
+	ila_corners(1,1) = bin_addr1_r(1,num_srch_red-1)
+	ila_corners(1,2) = bin_addr1_r(2,num_srch_red-1)
+	ila_corners(2,1) = bin_addr1_r(1,num_srch_red)
+	ila_corners(2,2) = bin_addr1_r(2,num_srch_red)
+	ila_corners(3:4,1:2) = 0                               
+	  	  
+    ELSE IF (rd_plat < bin_lats_r(1,num_srch_red-1)) THEN
+        ! in the last bin which is complet
+        ! the bin (num_srch_red-1) is the last bin which is complet
+	bin=num_srch_red-1
+	ila_corners(1,1) = bin_addr1_r(1,num_srch_red-2)
+	ila_corners(1,2) = bin_addr1_r(2,num_srch_red-2)
+	ila_corners(2,1) = bin_addr1_r(1,num_srch_red-1)
+	ila_corners(2,2) = bin_addr1_r(2,num_srch_red-1)
+	ila_corners(3,1) = bin_addr1_r(1,num_srch_red)
+	ila_corners(3,2) = bin_addr1_r(2,num_srch_red)
+	ila_corners(4,1:2) = 0 	  
+    ELSE 
+	il_min=2
+	il_max=num_srch_red-1
+	DO WHILE (il_min /= il_max-1)
+	  il_inter=(il_max-il_min)/2 + il_min
+	  IF (rd_plat <= bin_lats_r(1,il_min) .and. &
+	     rd_plat > bin_lats_r(1,il_inter)) THEN
+	      il_max=il_inter
+	  ELSE
+	      il_min=il_inter
+	  END IF
+	END DO
+	bin=il_min
+	ila_corners(1,1) = bin_addr1_r(1,bin-1)
+	ila_corners(1,2) = bin_addr1_r(2,bin-1)
+	ila_corners(2,1) = bin_addr1_r(1,bin)
+	ila_corners(2,2) = bin_addr1_r(2,bin)
+	ila_corners(3,1) = bin_addr1_r(1,bin+1) 
+	ila_corners(3,2) = bin_addr1_r(2,bin+1)
+	ila_corners(4,1) = bin_addr1_r(1,bin+2) 
+	ila_corners(4,2) = bin_addr1_r(2,bin+2) 
+	
+	IF (ila_corners(1,1)==0) THEN 
+	    ila_corners(1,1)=1
+	END IF
+    END IF
+	
+    DO ib_k=1,4 
+      IF (ila_corners(ib_k,1) .NE. 0)        &
+         rda_src_lats(ib_k)= grid1_center_lat(ila_corners(ib_k,1))
+    ENDDO
+
+    !
+    ! now perform a more detailed search for each line
+    !
+     
+    ida_src_add(:,:)=0
+    ida_nbr_found(:)=0
+    rda_src_lons(:,:)=0
+    
+    DO ib_k=1,4 ! for each line of found points
+      IF (ila_corners(ib_k,1)==0) THEN
+	  CYCLE 
+      END IF
+
+      il_min=ila_corners(ib_k,1)
+      il_max=ila_corners(ib_k,2)
+
+      IF (rd_plon < grid1_center_lon(il_min)) THEN	    	   
+	  DO ib_j=il_max-1, il_max
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)-pi2
+	    END IF
+	  END DO
+	  DO ib_j=il_min, il_min+1
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)
+	    END IF
+	  END DO
+	  
+      ELSE IF (rd_plon < grid1_center_lon(il_min+1)) THEN
+	  IF (grid1_mask(il_max) .or. ld_extrapdone) THEN 
+	      ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+	      ida_src_add(ib_k,ida_nbr_found(ib_k)) = il_max
+	      rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		 grid1_center_lon(il_max)-pi2
+	  END IF
+	  DO ib_j=il_min, il_min+2
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)
+	    END IF
+	  END DO
+	  
+      ELSE IF (rd_plon > grid1_center_lon(il_max)) THEN
+	  DO ib_j=il_max-1, il_max
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)
+	    END IF
+	  END DO
+	  DO ib_j=il_min, il_min+1
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)+pi2
+	    END IF
+	  END DO
+	  
+      ELSE IF (rd_plon > grid1_center_lon(il_max-1)) THEN
+	  DO ib_j=il_max-2, il_max
+	    IF (grid1_mask(ib_j) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k)) = ib_j
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_j)
+	    END IF
+	  END DO
+	  IF (grid1_mask(il_min) .or. ld_extrapdone) THEN 
+	      ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+	      ida_src_add(ib_k,ida_nbr_found(ib_k)) = il_min
+	      rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		 grid1_center_lon(il_min)+pi2
+	  END IF
+	  
+      ELSE 	  
+	  
+	  DO WHILE (il_min/=il_max-1)
+	    il_inter=(il_max-il_min)/2 + il_min
+	    IF (rd_plon >= grid1_center_lon(il_min) .and. &
+	       rd_plon < grid1_center_lon(il_inter)) THEN
+		il_max=il_inter
+	    ELSE
+		il_min=il_inter
+	    END IF
+	  END DO
+	  DO ib_i= il_min-1, il_min+2
+	    IF (grid1_mask(ib_i) .or. ld_extrapdone) THEN 
+		ida_nbr_found(ib_k)=ida_nbr_found(ib_k)+1
+		ida_src_add(ib_k,ida_nbr_found(ib_k))=ib_i
+		rda_src_lons(ib_k,ida_nbr_found(ib_k))= &
+		   grid1_center_lon(ib_i)
+	    END IF
+	  END DO	  	  
+
+      END IF
+	
+    END DO
+
+    
+  END SUBROUTINE grid_search_16_points
+  
+
+
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE:  calcul_wght_irreg
+!
+! !INTERFACE:
+! 
+  SUBROUTINE calcul_wght_irreg(rda_x, rd_pt, rda_wght)
+!  
+! !USES:
+!		       
+! !RETURN VALUE:
+!  
+    REAL (KIND=dbl_kind), DIMENSION(4), INTENT(out) :: &
+       rda_wght   ! array of weights for the points x
+!      
+! !PARAMETERS:
+! 
+    REAL (KIND=dbl_kind), DIMENSION(4), INTENT(in) :: &
+       rda_x ! array of positions on source grid, lat or lon
+      
+    REAL (KIND=dbl_kind),INTENT(in) :: &
+       rd_pt  ! position of target point to interpolate
+       
+    REAL (KIND=dbl_kind) :: &
+       rl_t1, rl_t2, rl_t3, rl_t4, rl_t5, rl_t6, rl_t7, rl_t8, rl_t9, &
+       rl_u1, rl_u2, rl_u3, rl_u4, &
+       rl_k1, rl_k2, rl_k3, &
+       rl_d1, rl_d2, rl_d3, rl_d4, &
+       rl_c1, rl_c2, rl_c3, rl_c4, &
+       rl_b1, rl_b2, rl_b3, rl_b4, &
+       rl_a1, rl_a2, rl_a3, rl_a4, &
+       rl_y1, rl_y2, rl_y3, &
+       rl_a1_y, rl_a2_y, rl_a3_y, rl_a4_y, &
+       rl_b1_y, rl_b2_y, rl_b3_y, rl_b4_y, &
+       rl_c1_y, rl_c2_y, rl_c3_y, rl_c4_y
+!		       
+! !DESCRIPTION:
+!  Calculates a the weights of four points for a bicubic interpolation. 
+!  The distances between the points can be irregulier. 
+!
+! !REVISION HISTORY:
+!  2002.10.21  J.Ghattas  created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------    
+ 
+    
+    IF (rda_x(1)/=0.and. rda_x(2)/=0 .and. rda_x(3)/=0 .and. rda_x(4)/=0) THEN
+	  
+	rl_t1 = 1/rda_x(1) - 1/rda_x(2)
+	rl_t2 = 1/rda_x(1)**2 - 1/rda_x(2)**2
+	rl_t3 = 1/rda_x(1)**3 - 1/rda_x(2)**3
+	rl_t4 = 1/rda_x(1) - 1/rda_x(3)
+	rl_t5 = 1/rda_x(1)**2 - 1/rda_x(3)**2
+	rl_t6 = 1/rda_x(1)**3 - 1/rda_x(3)**3
+	rl_t7 = 1/rda_x(1) - 1/rda_x(4)
+	rl_t8 = 1/rda_x(1)**2 - 1/rda_x(4)**2
+	rl_t9 = 1/rda_x(1)**3 - 1/rda_x(4)**3
+	  
+	rl_u1 = rl_t2/rl_t1 - rl_t5/rl_t4
+	rl_u2 = rl_t3/rl_t1 - rl_t6/rl_t4
+	rl_u3 = rl_t2/rl_t1 - rl_t8/rl_t7
+	rl_u4 = rl_t3/rl_t1 - rl_t9/rl_t7
+	
+	rl_k1 = (1/(rl_t1*rl_u1)-1/(rl_t1*rl_u3)) / (rl_u2/rl_u1-rl_u4/rl_u3)
+	rl_k2 = -1/(rl_t4*rl_u1) / (rl_u2/rl_u1-rl_u4/rl_u3)
+	rl_k3 = 1/(rl_t7*rl_u3) / (rl_u2/rl_u1-rl_u4/rl_u3)
+	
+	
+	rl_d1=(rl_k1+rl_k2+rl_k3)/rda_x(1)**3
+	rl_d2 = -rl_k1/rda_x(2)**3
+	rl_d3 = -rl_k2/rda_x(3)**3
+	rl_d4 = -rl_k3/rda_x(4)**3
+	
+	rl_c1 = 1/rl_u1*(1/(rl_t1*rda_x(1)**3)-1/(rl_t4*rda_x(1)**3)- &
+	   rl_u2*rl_d1)
+	rl_c2 = 1/rl_u1*(1/(-rl_t1*rda_x(2)**3)-rl_u2*rl_d2)
+	rl_c3 = 1/rl_u1*(1/(rl_t4*rda_x(3)**3)-rl_u2*rl_d3)
+	rl_c4 = 1/rl_u1*(-rl_u2*rl_d4)
+	
+	rl_b1 = 1/rl_t1/rda_x(1)**3-rl_t2/rl_t1*rl_c1-rl_t3/rl_t1*rl_d1
+	rl_b2 = -1/rl_t1/rda_x(2)**3-rl_t2/rl_t1*rl_c2-rl_t3/rl_t1*rl_d2
+	rl_b3 = -rl_t2/rl_t1*rl_c3-rl_t3/rl_t1*rl_d3
+	rl_b4 = -rl_t2/rl_t1*rl_c4-rl_t3/rl_t1*rl_d4
+	
+	rl_a1 = 1/rda_x(1)**3-1/rda_x(1)*rl_b1-1/rda_x(1)**2*rl_c1- &
+	   1/rda_x(1)**3*rl_d1
+	rl_a2 = -1/rda_x(1)*rl_b2-1/rda_x(1)**2*rl_c2-1/rda_x(1)**3*rl_d2
+	rl_a3 = -1/rda_x(1)*rl_b3-1/rda_x(1)**2*rl_c3-1/rda_x(1)**3*rl_d3
+	rl_a4 = -1/rda_x(1)*rl_b4-1/rda_x(1)**2*rl_c4-1/rda_x(1)**3*rl_d4
+	
+       ! Weights  
+	rda_wght(1) = rl_a1*rd_pt**3 + rl_b1*rd_pt**2 + rl_c1*rd_pt + rl_d1
+	rda_wght(2) = rl_a2*rd_pt**3 + rl_b2*rd_pt**2 + rl_c2*rd_pt + rl_d2
+	rda_wght(3) = rl_a3*rd_pt**3 + rl_b3*rd_pt**2 + rl_c3*rd_pt + rl_d3
+	rda_wght(4) = rl_a4*rd_pt**3 + rl_b4*rd_pt**2 + rl_c4*rd_pt + rl_d4
+	
+    ELSE ! there is one point = 0
+	  
+	rl_d1=0; rl_d2=0; rl_d3=0; rl_d4=0
+	
+        ! Transformation for each case
+	IF (rda_x(1)==0) THEN
+	    rl_y1=rda_x(2); rl_y2=rda_x(3); rl_y3=rda_x(4)
+	    rl_d1=1
+	ELSE IF (rda_x(2)==0) THEN
+	    rl_y1=rda_x(1); rl_y2=rda_x(3); rl_y3=rda_x(4)
+	    rl_d2=1
+	ELSE IF (rda_x(3)==0) THEN
+	    rl_y1=rda_x(1); rl_y2=rda_x(2); rl_y3=rda_x(4)
+	    rl_d3=1
+	ELSE 
+	    rl_y1=rda_x(1); rl_y2=rda_x(2); rl_y3=rda_x(3)
+	    rl_d4=1
+	END IF
+	
+        ! Solving the system 
+	rl_t1 = 1/rl_y1-1/rl_y2
+	rl_t2 = 1/rl_y1**2-1/rl_y2**2
+	rl_t3 = 1/rl_y1-1/rl_y3
+	rl_t4 = 1/rl_y1**2-1/rl_y3**2
+	
+	rl_c1_y =(1/rl_y1**3/rl_t1-1/rl_y1**3/rl_t3)/(rl_t2/rl_t1-rl_t4/rl_t3)
+	rl_c2_y = -1/rl_y2**3/rl_t1/(rl_t2/rl_t1-rl_t4/rl_t3)
+	rl_c3_y = 1/rl_y3**3/rl_t3/(rl_t2/rl_t1-rl_t4/rl_t3)
+	rl_c4_y=(-1/rl_y1**3/rl_t1+1/rl_y2**3/rl_t1+ &
+	   1/rl_y1**3/rl_t3-1/rl_y3**3/rl_t3)/(rl_t2/rl_t1-rl_t4/rl_t3)
+	
+	rl_b1_y = 1/rl_y1**3/rl_t1 - rl_c1_y*rl_t2/rl_t1
+	rl_b2_y = -1/rl_y2**3/rl_t1 - rl_c2_y*rl_t2/rl_t1
+	rl_b3_y = -rl_c3_y*rl_t2/rl_t1
+	rl_b4_y = -1/rl_y1**3/rl_t1 + 1/rl_y2**3/rl_t1 - rl_c4_y*rl_t2/rl_t1
+	
+	rl_a1_y = 1/rl_y1**3 - rl_b1_y/rl_y1 - rl_c1_y/rl_y1**2
+	rl_a2_y = -rl_b2_y/rl_y1 - rl_c2_y/rl_y1**2
+	rl_a3_y = -rl_b3_y/rl_y1 - rl_c3_y/rl_y1**2
+	rl_a4_y = -1/rl_y1**3 - rl_b4_y/rl_y1 - rl_c4_y/rl_y1**2
+	  
+        ! Retransformation
+	IF (rda_x(1)==0) THEN
+	    rl_a1=rl_a4_y; rl_a2=rl_a1_y; rl_a3=rl_a2_y; rl_a4=rl_a3_y
+	    rl_b1=rl_b4_y; rl_b2=rl_b1_y; rl_b3=rl_b2_y; rl_b4=rl_b3_y
+	    rl_c1=rl_c4_y; rl_c2=rl_c1_y; rl_c3=rl_c2_y; rl_c4=rl_c3_y
+	ELSE IF (rda_x(2)==0) THEN
+	    rl_a1=rl_a1_y; rl_a2=rl_a4_y; rl_a3=rl_a2_y; rl_a4=rl_a3_y
+	    rl_b1=rl_b1_y; rl_b2=rl_b4_y; rl_b3=rl_b2_y; rl_b4=rl_b3_y
+	    rl_c1=rl_c1_y; rl_c2=rl_c4_y; rl_c3=rl_c2_y; rl_c4=rl_c3_y
+	ELSE IF (rda_x(3)==0) THEN
+	    rl_a1=rl_a1_y; rl_a2=rl_a2_y; rl_a3=rl_a4_y; rl_a4=rl_a3_y
+	    rl_b1=rl_b1_y; rl_b2=rl_b2_y; rl_b3=rl_b4_y; rl_b4=rl_b3_y
+	    rl_c1=rl_c1_y; rl_c2=rl_c2_y; rl_c3=rl_c4_y; rl_c4=rl_c3_y
+	ELSE 
+	    rl_a1=rl_a1_y; rl_a2=rl_a2_y; rl_a3=rl_a3_y; rl_a4=rl_a4_y
+	    rl_b1=rl_b1_y; rl_b2=rl_b2_y; rl_b3=rl_b3_y; rl_b4=rl_b4_y
+	    rl_c1=rl_c1_y; rl_c2=rl_c2_y; rl_c3=rl_c3_y; rl_c4=rl_c4_y
+	END IF
+	
+        ! Weights  
+	rda_wght(1) = rl_a1*rd_pt**3 + rl_b1*rd_pt**2 + rl_c1*rd_pt +rl_d1
+	rda_wght(2) = rl_a2*rd_pt**3 + rl_b2*rd_pt**2 + rl_c2*rd_pt +rl_d2
+	rda_wght(3) = rl_a3*rd_pt**3 + rl_b3*rd_pt**2 + rl_c3*rd_pt +rl_d3
+	rda_wght(4) = rl_a4*rd_pt**3 + rl_b4*rd_pt**2 + rl_c4*rd_pt +rl_d4
+	
+    END IF
+      
+      
+  END SUBROUTINE calcul_wght_irreg
+  
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE:  calcul_wght_3
+!
+! !INTERFACE:
+  
+  SUBROUTINE calcul_wght_3(rda_x, rd_pt, rda_wght)
+
+! !USES:
+  
+! !RETURN VALUE:
+ 
+    REAL (KIND=dbl_kind), DIMENSION(3), INTENT(out) :: &
+       rda_wght         ! array of weights for the points x
+    
+! !PARAMETERS:
+
+    REAL (KIND=dbl_kind), DIMENSION(3), INTENT(in) :: &
+       rda_x         ! array of positions on source grid, lat or lon
+    
+    REAL (KIND=dbl_kind), INTENT(in) :: &
+       rd_pt        ! position of target point to interpolate
+    
+    REAL (KIND=dbl_kind) :: &
+       rl_c1, rl_c2, rl_c3, &
+       rl_a1, rl_a2, rl_a3, &
+       rl_b1, rl_b2, rl_b3, &
+       rl_t1, rl_t2, rl_t3, rl_t4
+      
+! !DESCRIPTION:
+!  Calculates a the weights of 3 points for a parabolic interpolation.
+! 
+! !REVISION HISTORY:
+!  2002.10.21  J.Ghattas  created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------
+    
+    
+    IF (rda_x(1)/=0 .and. rda_x(2)/=0 .and. rda_x(3)/=0) THEN    
+	rl_t1 = 1/rda_x(1)-1/rda_x(2)
+	rl_t2 = 1/rda_x(1)**2-1/rda_x(2)**2
+	rl_t3 = 1/rda_x(1)-1/rda_x(3)
+	rl_t4 = 1/rda_x(1)**2-1/rda_x(3)**2
+	
+	rl_c1 = (1/rda_x(1)**2/rl_t1-1/rda_x(1)**2/rl_t3) / &
+	   (rl_t2/rl_t1-rl_t4/rl_t3)
+	rl_c2 = -1/rda_x(2)**2/rl_t1 / (rl_t2/rl_t1-rl_t4/rl_t3)
+	rl_c3 = 1/rda_x(3)**2/rl_t3 / (rl_t2/rl_t1-rl_t4/rl_t3)
+	
+	rl_b1 = 1/rda_x(1)**2/rl_t1 - rl_c1*rl_t2/rl_t1
+	rl_b2 = -1/rda_x(2)**2/rl_t1 - rl_c2*rl_t2/rl_t1
+	rl_b3 = - rl_c3*rl_t2/rl_t1
+	
+	rl_a1 = 1/rda_x(1)**2 - rl_b1/rda_x(1) - rl_c1/rda_x(1)**2
+	rl_a2 = - rl_b2/rda_x(1) - rl_c2/rda_x(1)**2
+	rl_a3 = - rl_b3/rda_x(1) - rl_c3/rda_x(1)**2
+	
+	
+    ELSE IF (rda_x(1)==0) THEN
+	rl_c1 = 1; rl_c2 = 0; rl_c3 = 0
+	rl_b1 = (-1/rda_x(2)**2+1/rda_x(3)**2) / (1/rda_x(2)-1/rda_x(3))
+	rl_b2 = 1/rda_x(2)**2 / (1/rda_x(2)-1/rda_x(3))
+	rl_b3 = -1/rda_x(3)**2 / (1/rda_x(2)-1/rda_x(3))
+	
+	rl_a1 = -1/rda_x(2)**2 - rl_b1/rda_x(2)
+	rl_a2 = 1/rda_x(2)**2 - rl_b2/rda_x(2)
+	rl_a3 = - rl_b3/rda_x(2)
+	
+    ELSE IF (rda_x(2)==0) THEN
+	
+	rl_c1 = 0; rl_c2 = 1; rl_c3 = 0
+	rl_b1 = 1/rda_x(1)**2 / (1/rda_x(1)-1/rda_x(3))
+	rl_b2 = (-1/rda_x(1)**2+1/rda_x(3)**2) / (1/rda_x(1)-1/rda_x(3))
+	rl_b3 = -1/rda_x(3)**2 / (1/rda_x(1)-1/rda_x(3))
+	
+	rl_a1 = 1/rda_x(1)**2 - rl_b1/rda_x(1)
+	rl_a2 = -1/rda_x(1)**2 - rl_b2/rda_x(1)
+	rl_a3 = - rl_b3/rda_x(1)
+	
+    ELSE !rda_x(3)==0
+	rl_c1 = 0; rl_c2 = 0; rl_c3 = 1
+	rl_b1 = 1/rda_x(1)**2 / (1/rda_x(1)-1/rda_x(2))
+	rl_b2 = -1/rda_x(2)**2 / (1/rda_x(1)-1/rda_x(2))
+	rl_b3 = (-1/rda_x(1)**2+1/rda_x(2)**2) / (1/rda_x(1)-1/rda_x(2))
+	
+	rl_a1 = 1/rda_x(1)**2 - rl_b1/rda_x(1)
+	rl_a2 = - rl_b2/rda_x(1)
+	rl_a3 = -1/rda_x(1)**2 - rl_b3/rda_x(1)
+	
+	
+    END IF
+   
+    ! Weights  
+    rda_wght(1) = rl_a1*rd_pt**2 + rl_b1*rd_pt + rl_c1
+    rda_wght(2) = rl_a2*rd_pt**2 + rl_b2*rd_pt + rl_c2
+    rda_wght(3) = rl_a3*rd_pt**2 + rl_b3*rd_pt + rl_c3
+    
+    
+  END SUBROUTINE calcul_wght_3
+    
+
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE:  calcul_wght_2
+!
+! !INTERFACE:
+
+  SUBROUTINE calcul_wght_2(rda_x, rd_pt, rda_wght)
+ 		       
+! !USES:
+		       
+! !RETURN VALUE:
+  
+    REAL (KIND=dbl_kind), DIMENSION(2), INTENT(out) :: &
+       rda_wght      ! array of weights for the points x
+     
+! !PARAMETERS:
+
+    REAL (KIND=dbl_kind), DIMENSION(2), INTENT(in) :: &
+       rda_x      ! array of positions on source grid, lat or lon
+      
+    REAL (KIND=dbl_kind), INTENT(in) :: &
+       rd_pt     ! position of target point to interpolate
+    
+    REAL (KIND=dbl_kind) :: rl_b1, rl_b2, rl_a1, rl_a2
+    		       
+! !DESCRIPTION:
+!  Calculates a the weights of 2 points for a linair interpolation.
+!
+! !REVISION HISTORY:
+!  2002.10.21   J.Ghattas    created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------  
+    
+     
+    IF (rda_x(1)/=0 .and. rda_x(2)/=0) THEN
+	rl_b1 = 1/(1-rda_x(1)/rda_x(2))
+	rl_b2 = -1/(rda_x(2)/rda_x(1)-1)
+	rl_a1 = 1/rda_x(1) - rl_b1/rda_x(1)
+	rl_a2 = - rl_b2/rda_x(1)
+	
+    ELSE IF (rda_x(1)==0) THEN
+	rl_b1=1; rl_b2=0
+	rl_a1=-1/rda_x(2)
+	rl_a2=1/rda_x(2)
+    ELSE
+	rl_b1=0; rl_b2=1
+	rl_a1=1/rda_x(1)
+	rl_a2=-1/rda_x(1)
+    END IF
+      
+    rda_wght(1) = rl_a1*rd_pt + rl_b1 
+    rda_wght(2) = rl_a2*rd_pt + rl_b2
+    
+  END SUBROUTINE calcul_wght_2
+    
+
+!-----------------------------------------------------------------------
+! BOP
+!
+! !IROUTINE:  store_link_bicub
+!
+! !INTERFACE:
+ 
+  SUBROUTINE store_link_bicub(id_dst_add, ida_src_add, rda_wght)
+    
+! !USES:
+  
+! !RETURN VALUE:
+
+! !PARAMETERS:
+
+    INTEGER (KIND=int_kind), INTENT(in) :: &
+       id_dst_add    ! address on destination grid
+    
+    INTEGER (KIND=int_kind), DIMENSION(4,4), INTENT(in) :: &
+       ida_src_add   ! addresses for links on source grid
+    
+    REAL (KIND=dbl_kind), DIMENSION(4,4), INTENT(in) :: &
+       rda_wght      ! array of remapping weights for these links
+      
+    INTEGER (KIND=int_kind) :: ib_i, &
+       il_num_links_old  ! placeholder for old link number
+    
+    INTEGER (KIND=int_kind), DIMENSION(16) :: &
+       ila_src_add   ! reshaped addresses
+    
+    REAL (KIND=dbl_kind), DIMENSION(16) :: &
+       rla_wght      ! reshaped weights
+    
+! !DESCRIPTION:
+!  This routine stores the addresses and weights for 16 links associated 
+!  with one destination point in the appropriate address.  
+!
+! !REVISION HISTORY:
+!  2002.10.21    J.Ghattas   created
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id: remap_bicubic_reduced.F90 2826 2010-12-10 11:14:21Z valcke $
+! $Author: valcke $
+!-----------------------------------------------------------------------    
+    
+   
+    !
+    ! Increment number of links and check if remap arrays need
+    ! to be increased to accomodate the new link.  then store the link.
+    !
+     
+    il_num_links_old  = num_links_map1
+    num_links_map1 = il_num_links_old + 16
+    
+    IF (num_links_map1 > max_links_map1) THEN
+	CALL resize_remap_vars(1,MAX(resize_increment,16))
+    END IF
+    
+    ila_src_add=RESHAPE(ida_src_add,(/16/))
+    rla_wght=RESHAPE(rda_wght,(/16/))
+    
+    DO ib_i=1,16
+      grid1_add_map1(il_num_links_old+ib_i) = ila_src_add(ib_i)
+      grid2_add_map1(il_num_links_old+ib_i) = id_dst_add
+      wts_map1(1,il_num_links_old+ib_i) = rla_wght(ib_i)
+    END DO
+        
+  END SUBROUTINE store_link_bicub
+    
+    
+END MODULE remap_bicubic_reduced
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear.f	(revision 4775)
@@ -0,0 +1,760 @@
+C****
+C               *****************************
+C               * OASIS MODULE  -  LEVEL ? *
+C               * -------------     ------- *
+C               *****************************
+C
+C**** remap_bilinear - calculate bilinear remapping
+C
+C     Purpose:
+C     -------
+C     Adaptation of SCRIP 1.4 remap_bilinear module to calculate 
+C     bilinear remapping.
+C
+C**   Interface:
+C     ---------
+C       *CALL*  *remap_bilin**
+C
+C     Input:
+C     -----
+C
+C     Output:
+C     ------
+C
+C     History:
+C     -------
+C       Version   Programmer     Date        Description
+C       -------   ----------     ----        -----------  
+C       2.5       S. Valcke      2002/09     Treatment for masked point
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      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 (lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+      LOGICAL :: ll_nnei        ! true (default) if extra search is done
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, i, k,
+     &     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
+     &     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
+
+      real (kind=dbl_kind) ::  
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance, ! for computing dist-weighted avg
+     &      src_latsnn, arg
+
+      integer (kind=int_kind) :: min_add, max_add, srch_add, src_addnn
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine remap_bilin'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      ll_nnei = .true.
+      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,
+     &                         min_add, max_add, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, lextrapdone)
+
+        if (src_add(1) > 0) THEN
+
+          !***
+          !*** if the 4 surrounding points have been found and are 
+          !*** non-masked, do bilinear interpolation
+          !***
+
+          grid2_frac(dst_add) = one
+
+
+          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
+            write(nulou,*)'Point coords: ',plat,plon
+            do k = 1,size(src_add)
+               if (src_add(k) > 0) then
+                  write(nulou,*)'Dest grid info: ',
+     &               src_add(k),src_lats(k),src_lons(k),
+     &               grid1_mask(src_add(k))
+               else
+                  write(nulou,*)'Dest grid info: ',
+     &               src_add(k),src_lats(k),src_lons(k)
+               endif
+            enddo
+            write(nulou,*)'Current i,j : ',iguess, jguess
+            write(nulou,*)'Iteration for i,j exceed max iteration count'
+            stop 
+          endif
+
+      else if (src_add(1) < 0) THEN
+
+          !***
+          !*** Search for bilinear failed or at least one of the 4
+          !*** neighbours was masked. Do distance-weighted average using
+          !*** the non-masked points among the 4 closest ones. 
+          !***
+
+          IF (nlogprt .eq. 2) then
+              WRITE(nulou,*) ' '
+              WRITE(nulou,*) 
+     &   'WARNING: Cannot make bilinear interpolation for target point'
+     &            ,dst_add
+              WRITE(nulou,*) 
+     &    'Using non-masked points among 4 nearest neighbors.'
+              WRITE(nulou,*) ' '
+          ENDIF
+
+          !***
+          !*** Find the 4 closest points
+          !***
+
+          coslat_dst = cos(plat)
+          sinlat_dst = sin(plat)
+          coslon_dst = cos(plon)
+          sinlon_dst = sin(plon)
+          src_add = 0
+          dist_min = bignum
+          src_lats = bignum
+          do srch_add = min_add,max_add
+            arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &           (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &            sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &            sinlat_dst*sin(grid1_center_lat(srch_add))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF
+            distance=acos(arg)
+
+            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
+
+          !***
+          !*** Among 4 closest points, keep only the non-masked ones
+          !***
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n)) .or.
+     &          (.not. grid1_mask(src_add(n)) .and. lextrapdone)) 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)
+          ELSE
+              IF (ll_nnei .eqv. .true. ) then
+              IF (nlogprt .ge. 2) THEN
+                  WRITE(nulou,*) '  '
+                  WRITE(nulou,*) 
+     &                'All 4 surrounding source grid points are masked'
+                  WRITE(nulou,*) 'for target point ',dst_add
+                  WRITE(nulou,*) 'with longitude and latitude', 
+     &                plon, plat
+                  WRITE(nulou,*) 
+     &                'Using the nearest non-masked neighbour.'
+                  CALL OASIS_FLUSH_SCRIP(nulou)
+              ENDIF
+C
+              src_latsnn = bignum
+!cdir novector
+              do srch_add = min_add,max_add
+                if (grid1_mask(srch_add) .or.
+     &          (.not. grid1_mask(srch_add) .and. lextrapdone)) THEN
+                    arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &                  (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(grid1_center_lat(srch_add))
+                    IF (arg < -1.0d0) THEN
+                        arg = -1.0d0
+                    ELSE IF (arg > 1.0d0) THEN
+                        arg = 1.0d0
+                    END IF
+                    distance=acos(arg)
+
+                    if (distance < src_latsnn) then
+                        src_addnn = srch_add
+                        src_latsnn = distance
+                    endif
+                endif
+              end DO
+              IF (nlogprt .ge. 2) THEN
+                  WRITE(nulou,*) '  '
+                  WRITE(nulou,*) 
+     &                'Nearest non masked neighbour is source point '
+     &                ,src_addnn
+                  WRITE(nulou,*) 'with longitude and latitude',
+     &                grid1_center_lon(src_addnn), 
+     &                grid1_center_lat(src_addnn) 
+              ENDIF
+              wgts(1) = 1.
+              wgts(2) = 0.
+              wgts(3) = 0.
+              wgts(4) = 0.
+              src_add(1) = src_addnn
+              src_add(2) = 0
+              src_add(3) = 0
+              src_add(4) = 0
+
+              grid2_frac(dst_add) = one
+              call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+      ENDIF
+      ENDIF
+      end do grid_loop1
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine remap_bilin'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons, 
+     &                             min_add, max_add,
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_grid_bound_box,
+     &                             src_bin_add, lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      integer (kind=int_kind) :: min_add, max_add
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add, ni,   ! dummy indices
+     &    nx, ny, ntotmask,           ! dimensions of src grid
+     &    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
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+          !*** find ip1
+          !*** Note: I do not want to take into account the number
+          !*** of overlapping grid points, as the underlying cell
+          !*** will be found in all cases if the grid overlaps.
+
+          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
+
+           ! Check if one point is masked; IF so, nearest-neighbour
+           ! interpolation will be used  
+
+            ntotmask = 0
+            do ni=1,4
+              if (.not. grid1_mask(src_add(ni)).and. 
+     &            .not. lextrapdone) 
+     &            ntotmask = ntotmask + 1 
+            end DO
+            IF (ntotmask .gt. 0) src_add(1) = -src_add(1)
+        
+            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. Put src_add = -1 so that
+      !*** distance-weighted average of the 4 non-masked closest points
+      !*** is done in calling routine.
+  
+      src_add = -1
+
+!-----------------------------------------------------------------------
+
+      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: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear_reduced.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear_reduced.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_bilinear_reduced.f	(revision 4775)
@@ -0,0 +1,680 @@
+C****
+C               *****************************
+C               * OASIS MODULE  -  LEVEL ? *
+C               * -------------     ------- *
+C               *****************************
+C
+C**** remap_bilinear_reduced - calculate reduced grid bilinear remapping
+C
+C     Purpose:
+C     -------
+C     Adaptation of SCRIP 1.4 remap_bilinear module to calculate 
+C     bilinear remapping for reduced grids.
+C
+C**   Interface:
+C     ---------
+C       *CALL*  *remap_bilin_reduced*
+C
+C     Input:
+C     -----
+C
+C     Output:
+C     ------
+C
+C     History:
+C     -------
+C       Version   Programmer     Date        Description
+C       -------   ----------     ----        -----------  
+C       2.5       D. Declat      2002/07     created
+C       2.5       S. Valcke      2002/09     modified
+C
+C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation on reduced grids.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear_reduced.f 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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_reduced
+
+!-----------------------------------------------------------------------
+
+      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
+      USE mod_oasis_flush
+
+      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_reduced (lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+      LOGICAL :: ll_nnei        ! true (default) if extra search is done
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, icount, i,
+     &     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
+     &     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
+
+      real (kind=dbl_kind) ::  
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance, ! for computing dist-weighted avg
+     &      src_latsnn, arg
+
+      integer (kind=int_kind) :: min_add, max_add, srch_add, src_addnn
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)
+     &       'Entering routine remap_bilin_reduced'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      ll_nnei = .true.
+      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_rd(src_add, src_lats, src_lons, 
+     &                            min_add, max_add,
+     &                            plat, plon, grid1_dims,
+     &                            grid1_center_lat, grid1_center_lon,
+     &                            lextrapdone)
+        if (src_add(1) > 0) THEN
+
+        !***
+        !*** if the 4 surrounding points have been found and are 
+        !*** non-masked, do bilinear interpolation
+        !***
+
+          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
+            write(nulou,*) 'Point coords: ',plat,plon
+            write(nulou,*) 'Dest grid lats: ',src_lats
+            write(nulou,*) 'Dest grid lons: ',src_lons
+            write(nulou,*) 'Dest grid addresses: ',src_add
+            write(nulou,*) 'Current i,j : ',iguess, jguess
+            write(nulou,*) 
+     &          'Iteration for i,j exceed max iteration count'
+            stop 
+          endif
+
+        else if (src_add(1) < 0) THEN
+
+          !***
+          !*** We are in the first or last bin or at least one of the 4
+          !*** neighbours was masked. Do distance-weighted average using
+          !*** the non-masked points among the 4 closest ones. 
+
+          IF (nlogprt .eq. 2) then
+              WRITE(nulou,*) ' '
+              WRITE(nulou,*) 
+     &   'WARNING: Cannot make bilinear interpolation for target point'
+     &            ,dst_add
+              WRITE(nulou,*) 
+     &    'Using non-masked points among 4 nearest neighbors.'
+              CALL OASIS_FLUSH_SCRIP(nulou)
+          ENDIF
+
+          !***
+          !*** Find the 4 closest points
+          !***
+
+          coslat_dst = cos(plat)
+          sinlat_dst = sin(plat)
+          coslon_dst = cos(plon)
+          sinlon_dst = sin(plon)
+          src_add = 0
+          dist_min = bignum
+          src_lats = bignum
+          IF (min_add == 0) min_add = 1
+          IF (max_add > grid1_size) max_add = grid1_size
+          do srch_add = min_add,max_add
+            arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &           (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &            sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &            sinlat_dst*sin(grid1_center_lat(srch_add))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF    
+            distance=acos(arg)
+
+            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
+
+          !***
+          !*** Among 4 closest points, keep only the non-masked ones
+          !***
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n)) .or.
+     &          (.not. grid1_mask(src_add(n)) .and. lextrapdone)) 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)
+          ELSE
+              IF (ll_nnei .eqv. .true. ) then
+              IF (nlogprt .ge. 2) THEN
+                  WRITE(nulou,*) '  '
+                  WRITE(nulou,*) 
+     &                'All 4 surrounding source grid points are masked'
+                  WRITE(nulou,*) 'for target point ',dst_add
+                  WRITE(nulou,*) 'with longitude and latitude', 
+     &                plon, plat
+                  WRITE(nulou,*) 
+     &                'Using the nearest non-masked neighbour.'
+                  CALL OASIS_FLUSH_SCRIP(nulou)
+              ENDIF
+              src_latsnn = bignum
+!cdir novector
+              do srch_add = min_add,max_add
+                if (grid1_mask(srch_add) .or.
+     &          (.not. grid1_mask(srch_add) .and. lextrapdone)) THEN
+                    arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &                  (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(grid1_center_lat(srch_add))
+                    IF (arg < -1.0d0) THEN
+                        arg = -1.0d0
+                    ELSE IF (arg > 1.0d0) THEN
+                        arg = 1.0d0
+                    END IF
+                    distance=acos(arg)
+
+                    if (distance < src_latsnn) then
+                        src_addnn = srch_add
+                        src_latsnn = distance
+                    endif
+                endif
+              end DO
+              IF (nlogprt .ge. 2) THEN
+                  WRITE(nulou,*) 
+     &                'Nearest non masked neighbour is source point '
+     &                ,src_addnn
+                  WRITE(nulou,*) 'with longitude and latitude',
+     &                grid1_center_lon(src_addnn), 
+     &                grid1_center_lat(src_addnn) 
+                  WRITE(nulou,*) '  '
+                  CALL OASIS_FLUSH_SCRIP(nulou)
+              ENDIF
+              wgts(1) = 1.
+              wgts(2) = 0.
+              wgts(3) = 0.
+              wgts(4) = 0.
+              src_add(1) = src_addnn
+              src_add(2) = 0
+              src_add(3) = 0
+              src_add(4) = 0
+
+              grid2_frac(dst_add) = one
+              call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+          ENDIF
+      ENDIF
+      end do grid_loop1
+!
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin_reduced
+
+!***********************************************************************
+
+      subroutine grid_search_bilin_rd(src_add, src_lats, src_lons,
+     &                                min_add, max_add,
+     &                                plat, plon, src_grid_dims,
+     &                                src_center_lat, src_center_lon,
+     &                                lextrapdone)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation. The target grid is a reduced grid.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      integer (kind=int_kind) :: min_add, max_add
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add, ni,  ! dummy indices
+     &    nx, ny, ntotmask,           ! dimensions of src grid
+     &    inter_add ! add for restricting search
+!
+      integer (kind=int_kind), DIMENSION(4) :: src_bid
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      inter_add = 0
+
+      src_add = 0
+
+      min_add = size(src_center_lat) + 1
+      max_add = 1
+      if (plat >= bin_lats_r(1,1)) then
+          min_add = 0
+          max_add = bin_addr1_r(4,1)
+          inter_add = bin_addr1_r(3,1)
+      else if (plat <= bin_lats_r(1,num_srch_red)) then
+          max_add = nx + 1
+          min_add = bin_addr1_r(1,num_srch_red)
+          inter_add = bin_addr1_r(3,num_srch_red)
+      else
+          srch_loopred: do n=1,num_srch_red
+            if (plat <= bin_lats_r(1,n) 
+     &        .and. plat >= bin_lats_r(2,n)) then
+                min_add = bin_addr1_r(1,n)
+                max_add = bin_addr1_r(4,n)
+                inter_add = bin_addr1_r(3,n)
+                exit srch_loopred
+            endif
+          end DO srch_loopred
+      ENDIF
+
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+      if (min_add .ne. 0 .and. max_add .ne. nx+1) THEN
+         !*** The concerned bins are not the top north or south ones.
+         !*** We should be able to find the four corners
+         !*** for the bilinear interpolation.
+
+          IF ( plon <= src_center_lon(min_add) ) THEN
+              src_add(1) = inter_add-1
+              src_add(2) = min_add
+          ELSE IF ( plon > src_center_lon(inter_add-1) ) then
+              src_add(1) = inter_add-1
+              src_add(2) = min_add
+          else
+              srch_loop2: do srch_add = min_add, inter_add-2
+                 if ( (plon > src_center_lon(srch_add)) .and.
+     &            (plon <= src_center_lon(srch_add+1)) )then
+                     src_add(1) = srch_add
+                     src_add(2) = srch_add+1
+                     exit srch_loop2
+                 endif
+               end do srch_loop2
+           ENDIF
+           IF ( plon <= src_center_lon(inter_add) ) THEN
+               src_add(3) = max_add
+               src_add(4) = inter_add
+           ELSE IF ( plon >= src_center_lon(max_add) ) then
+               src_add(3) = max_add
+               src_add(4) = inter_add
+           else
+               srch_loop3: do srch_add = inter_add, max_add
+                 if ( (plon >= src_center_lon(srch_add)) .and.
+     &             (plon <= src_center_lon(srch_add+1)) )then
+                      src_add(3) = srch_add
+                      src_add(4) = srch_add+1
+                      exit srch_loop3
+                  endif
+               enddo srch_loop3
+           ENDIF
+           src_lats(1) = src_center_lat(src_add(3))
+           src_lats(2) = src_center_lat(src_add(4))
+           src_lats(3) = src_center_lat(src_add(2))
+           src_lats(4) = src_center_lat(src_add(1))
+      
+           src_lons(1) = src_center_lon(src_add(3))
+           src_lons(2) = src_center_lon(src_add(4))
+           src_lons(3) = src_center_lon(src_add(2))
+           src_lons(4) = src_center_lon(src_add(1))
+
+           src_bid=src_add
+
+           src_add(1) = src_bid(3)
+           src_add(2) = src_bid(4)
+           src_add(3) = src_bid(2)
+           src_add(4) = src_bid(1)
+    
+           ! Check if one point is masked; IF so, nearest-neighbour
+           ! interpolation will be used 
+
+           ntotmask = 0
+           do ni=1,4
+             if (.not. grid1_mask(src_add(ni)).and. 
+     &           .not. lextrapdone) 
+     &           ntotmask = ntotmask + 1 
+           end DO
+           IF (ntotmask .gt. 0) src_add(1) = -src_add(1) 
+          
+       ELSE 
+
+           !*** We are in the first or last bin.  Put src_add = -1 so that
+           !*** distance-weighted average of the 4 non-masked closest points
+           !*** is done in calling routine. 
+
+           src_add = -1
+
+       ENDIF
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin_rd 
+
+!***********************************************************************
+
+      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_reduced
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_conserv.F
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_conserv.F	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_conserv.F	(revision 4775)
@@ -0,0 +1,2651 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C**** 
+C***********************************************************************
+C     This module belongs to the SCRIP library. It is modified to run
+C     within OASIS. 
+C     Main modifications:
+C       - Some allocated array will be freed in the end to allow multiple
+C         calls of SCRIP
+C       - Introduction of a logical flag to distinguish between the first
+C         and following calls of scrip conservative remapping
+C       - Masking of overlapping grid points for source and target grid
+C         For these points, links and weights of overlapped point are used
+C
+C     Modified by            V. Gayler,  M&D                  20.09.2001
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 1811 2008-12-19 08:41:41Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+#ifdef TREAT_OVERLAY
+      integer (kind=int_kind), DIMENSION(:), allocatable :: 
+     $    grid2_overlap ! overlapping points
+#endif
+
+      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 
+     &        overunit
+
+      logical (kind=log_kind) :: 
+     &        lcoinc,  ! flag for coincident segments
+     &        lrevers, ! flag for reversing direction of segment
+     &        lbegin,  ! flag for first integration of a segment
+     &        full,    !
+     &        ll_debug ! for debug outputs
+
+
+      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
+     &     delta,                          ! precision
+     &     r2d 
+      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
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine remap_conserv'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     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))
+
+#ifdef TREAT_OVERLAY
+
+! Check overlapping point of the source grid
+!
+      IF (nlogprt .GE. 2) THEN      
+          WRITE(nulou,*) 'Check overlapping point of the source grid'
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+
+      CALL get_unit(overunit)
+
+      OPEN(overunit, FILE = './overlap.dat', STATUS = 'UNKNOWN')
+      WRITE(overunit, *) 'list of overlapping point of the source grid'
+      WRITE(overunit,*) 'grid1_size =', grid1_size
+
+      delta = epsilon(1.)
+
+! Initialise array that contains addresse of overlap grid point
+      DO grid1_add = 1,grid1_size
+        grid1_add_repl1(grid1_add)=grid1_add
+      END DO
+
+      do grid1_add = 1,grid1_size
+
+        DO n = grid1_add+1, grid1_size
+          IF ((ABS(grid1_center_lon(grid1_add)-
+     $        grid1_center_lon(n))<delta).and.
+     $        (ABS(grid1_center_lat(grid1_add)-
+     $        grid1_center_lat(n))<delta)) THEN
+              IF (grid1_mask(n) .or. grid1_mask(grid1_add)) THEN
+                  WRITE(overunit,*)grid1_add, grid1_mask(grid1_add)
+     $                , n, grid1_mask(n)
+                  IF (grid1_mask(n)) THEN
+                      grid1_mask(n) = .false.
+                      grid1_mask(grid1_add) = .true.
+                      grid1_add_repl1(grid1_add) = n
+                  ENDIF
+                  WRITE(overunit,*)grid1_add, grid1_mask(grid1_add)
+     $                , n, grid1_mask(n) 
+              ENDIF
+          END IF
+        END DO
+        
+      END DO
+
+! Check overlapping point of the target grid
+!
+      IF (nlogprt .GE. 2) THEN      
+          WRITE(nulou,*) 'Check overlapping point of the target grid'
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF      
+
+      WRITE(overunit, *) 'list of overlapping point of the target grid'
+      WRITE(overunit,*) 'grid2_size =', grid2_size
+      allocate(grid2_overlap(grid2_size))
+      grid2_overlap = -1
+
+      delta = epsilon(1.)
+
+      DO grid2_add = 1,grid2_size
+        DO n = grid2_add+1, grid2_size
+          IF ((ABS(grid2_center_lon(grid2_add)-
+     $        grid2_center_lon(n))<delta).and.
+     $        (ABS(grid2_center_lat(grid2_add)-
+     $        grid2_center_lat(n))<delta)) THEN
+              grid2_overlap(grid2_add) = n
+              WRITE(overunit,*)grid2_add, grid2_mask(grid2_add)
+     $            , n, grid2_mask(n) 
+          END IF
+        END DO
+
+      END DO
+
+      CALL release_UNIT(overunit)
+
+#endif TREAT_OVERLAY
+
+! Sweeps
+      IF (nlogprt .GE. 2) THEN
+         WRITE (nulou,*) 'grid1 sweep '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      ll_debug = .false.
+      do grid1_add = 1,grid1_size
+        IF (ll_debug) THEN 
+            WRITE(88,*) 'grid1_add=', grid1_add
+            CALL OASIS_FLUSH_SCRIP(88)
+        ENDIF
+
+        !***
+        !*** 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)
+        IF (ll_debug) THEN 
+            WRITE(88,*)'    '
+            WRITE(88,*)'  ** Grid1 cell and associated search cells **'
+            DO corner = 1,grid1_corners 
+              WRITE(88,1111) corner, 
+     &            grid1_corner_lon(corner,grid1_add), 
+     &            grid1_corner_lat(corner,grid1_add)
+            ENDDO
+            WRITE(88,*) '  num_srch_cells=', num_srch_cells
+            WRITE(88,*) '    '
+            IF (num_srch_cells .ne. 0) 
+     &          WRITE(88,*) '  srch_add(:)=', srch_add(:)
+            DO n=1, num_srch_cells
+              DO corner = 1,grid2_corners
+                WRITE(88,1112) n, srch_corner_lon(corner,n),
+     &            srch_corner_lat(corner,n)
+              END DO
+            END DO
+            WRITE(88,*)'    ***************************************'
+            WRITE(88,*)'    '
+            CALL OASIS_FLUSH_SCRIP(88)
+        ENDIF
+ 1111 format ('   grid1 corner, lon, lat = ', I8, 2X, F12.4, 2X, F12.4)
+ 1112 format ('     srch cell, lon, lat = ', I8, 2X, F12.4, 2X, F12.4)       
+
+        !***
+        !*** 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.
+              IF (ll_debug) WRITE(88, *) ' sweep1 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 (ll_debug) THEN
+              IF (endlon .eq. beglon) THEN
+                  WRITE(88,1113) beglon, beglat 
+                  WRITE(88,1114) endlon, endlat
+                  WRITE(88, *)'  sweep1 endlon == beglon; skip segment'
+                  WRITE(88,*) '             '
+              ENDIF
+          ENDIF
+ 1113 format ('   endlon == beglon;  beglon, beglat = ', 
+     &        2X, F12.4, 2X, F12.4)
+ 1114 format ('   endlon == beglon;  endlon, endlat = ', 
+     &        2X, F12.4, 2X, F12.4)
+
+          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
+                    write(nulou,*) 'ERROR=>integration stalled:' 
+                    write(nulou,*) 'num_subseg exceeded limit'
+                    write(nulou,*) 
+     &                  '=>Verify corners in grids.nc, especially'
+                    write(nulou,*) 
+     &                  'if calculated by OASIS routine corners' 
+                    write(nulou,*) 
+     &                 'integration stalled: num_subseg exceeded limit'
+                    CALL OASIS_FLUSH_SCRIP(nulou)
+                    stop
+                endif
+
+                !***
+                !*** find next intersection of this segment with a grid
+                !*** line on grid 2.
+                !***
+
+                call timer_start(2)
+
+                IF (ll_debug) THEN
+                    WRITE(88,*) '             '
+                    WRITE(88,1115) beglon, beglat 
+                    WRITE(88,1116) endlon, endlat
+                    WRITE(88,*) '             '
+                    CALL OASIS_FLUSH_SCRIP(88)
+                ENDIF
+ 1115 format ('   avant intersection;  beglon, beglat = ', 
+     &        2X, F12.4, 2X, F12.4)
+ 1116 format ('   avant intersection;  endlon, endlat = ', 
+     &        2X, F12.4, 2X, F12.4)
+
+                call intersection(grid2_add,intrsct_lat,intrsct_lon,
+     &              lcoinc, beglat, beglon, endlat, endlon, begseg, 
+     &              lbegin, lrevers)
+
+                IF (ll_debug) THEN
+                    WRITE(88,*) ' After call intersection, grid2_add',
+     &                  grid2_add
+                    WRITE(88,1117) beglon, beglat 
+                    WRITE(88,1118) endlon, endlat
+                    WRITE(88,1119) intrsct_lon, intrsct_lat
+                    WRITE(88,*) '   '
+                    CALL OASIS_FLUSH_SCRIP(88)
+                ENDIF
+ 1117 format('   aprÃšs intersection;  beglon, beglat =           ', 
+     &        2X, F12.4, 2X, F12.4)
+ 1118 format ('   aprÃšs intersection;  endlon, endlat =          ', 
+     &        2X, F12.4, 2X, F12.4)
+ 1119 format ('   aprÃšs intersection; intrsct_lon, intrsct_lat = ', 
+     &              2X, F12.4, 2X, F12.4)
+
+                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_lon(grid1_add),
+     &                         grid2_center_lon(grid2_add))
+
+                    IF (ll_debug) THEN
+                      WRITE(88,*) '  A1) WEIGHTS for this subsegment =',
+     &                      weights(1)
+                      WRITE(88,*) '     '
+                      CALL OASIS_FLUSH_SCRIP(88)
+                    ENDIF
+
+                else
+                    call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lon(grid1_add),
+     &                         grid1_center_lon(grid1_add))
+
+                   IF (ll_debug) THEN
+                     WRITE(88,*) '  B1) WEIGHTS for this subsegment =',
+     &                     weights(1)
+                     WRITE(88,*) '     '
+                     CALL OASIS_FLUSH_SCRIP(88)
+                    ENDIF
+
+                endif
+                call timer_stop(3)
+
+                !***
+                !*** if integrating in reverse order, change
+                !*** sign of weights
+                !***
+
+                if (lrevers) then
+                    weights = -weights
+                IF (ll_debug) THEN
+                WRITE(88,*) '  LREVERS; WEIGHTS for this subsegment =',
+     &                weights(1)
+                    WRITE(88,*) '     '
+                ENDIF
+                ENDIF
+
+ 
+                !***
+                !*** store the appropriate addresses and weights. 
+                !*** also add contributions to cell areas and centroids.
+                !***
+ 1120 format ('      STORE add1,add2,blon,blat,ilon,ilat,WEIGHTS=', 
+     &         1X,I8,1X,I8,1X,F12.8,1X,F12.8,1X,F12.8,1X,F12.8, E12.8)
+ 1121 format ('      overlap STORE grid1_add, grid2_add, WEIGHTS=', 
+     &         1X,I8,1X,I8,1X,F12.8,1X,F12.8,1X,F12.8,1X,F12.8, E12.8)
+ 1122 format ('      lfracnei STORE grid1_add, grid2_add, WEIGHTS=', 
+     &         1X,I8,1X,I8,1X,F12.8,1X,F12.8,1X,F12.8,1X,F12.8, E12.8)
+                if (grid2_add /= 0) then
+                    if (grid1_mask(grid1_add)) then
+                        call timer_start(4)
+                        call store_link_cnsrv(grid1_add, grid2_add, 
+     &                      weights)
+
+                   IF (ll_debug) THEN
+                   WRITE(88,*) '      after store_link_cnsrv norm1'
+                   WRITE(88,1120) grid1_add, grid2_add,beglon, beglat,
+     &   intrsct_lon,intrsct_lat,weights(1)
+                   ENDIF
+#ifdef TREAT_OVERLAY
+                        IF (grid2_overlap(grid2_add)/=-1) then
+                            call store_link_cnsrv(grid1_add,
+     &                          grid2_overlap(grid2_add), weights)
+
+                            IF (ll_debug) THEN
+                   WRITE(88,*) '      after store_link_cnsrv overlap1'
+                   WRITE(88,1121) grid1_add, grid2_add,beglon, beglat,
+     &   intrsct_lon,intrsct_lat,weights(1)
+                            ENDIF
+                        ENDIF
+#endif
+
+                        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)
+#ifdef TREAT_OVERLAY
+                        IF (grid2_overlap(grid2_add)/=-1)
+     $                      grid2_frac(grid2_overlap(grid2_add)) =
+     $                      grid2_frac(grid2_overlap(grid2_add)) +
+     $                      weights(num_wts+1)
+#endif
+                    else if (lfracnnei) THEN
+                        weights = 0  
+                        call store_link_cnsrv(grid1_add, 
+     $                      grid2_add, weights)
+
+                        IF (ll_debug) THEN
+           WRITE(88,*) '      after store_link_cnsrv fracnnei1'
+           WRITE(88,1122) grid1_add, grid2_add,beglon, beglat,
+     &   intrsct_lon,intrsct_lat,weights(1)
+                        ENDIF
+                    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)
+      IF (nlogprt .GE. 2) THEN 
+          WRITE(nulou,*) 'grid1 end sweep '
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+      IF (nlogprt .GE. 2) THEN 
+          WRITE(nulou,*) 'grid2 sweep '
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+      do grid2_add = 1,grid2_size
+        IF (ll_debug) THEN 
+            WRITE(88,*) 'grid2_add=', grid2_add
+            CALL OASIS_FLUSH_SCRIP(88)
+        ENDIF
+        !***
+        !*** 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)
+        IF (ll_debug) THEN
+            WRITE(88,*)'    '
+            WRITE(88,*)'  ** Grid2 cell and associated search cells **'
+            DO corner = 1,grid2_corners 
+              WRITE(88,1131) corner, 
+     &            grid2_corner_lon(corner,grid2_add), 
+     &            grid2_corner_lat(corner,grid2_add)
+            ENDDO
+            WRITE(88,*) '  num_srch_cells=', num_srch_cells
+            WRITE(88,*) '    '
+            WRITE(88,*) '  srch_add(:)=', srch_add(:)
+            DO n=1, num_srch_cells
+              DO corner = 1,grid2_corners
+                WRITE(88,1132) n, srch_corner_lon(corner,n),
+     &            srch_corner_lat(corner,n)
+              END DO
+            END DO
+            WRITE(88,*)'    ***************************************'
+            WRITE(88,*)'    '
+        ENDIF
+ 1131 format ('   grid2 corner, lon, lat = ', I8, 2X, F12.4, 2X, F12.4)
+ 1132 format ('     srch cell, lon, lat = ', I8, 2X, F12.4, 2X, F12.4)  
+
+        !***
+        !*** integrate around this cell
+        !***
+
+!        full = .false.
+!        do grid1_add = min_add,max_add
+!          if (grid1_mask(grid1_add)) full = .true.
+!        end do
+!        if (full) then
+
+        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.
+            IF (ll_debug) 
+     $          WRITE(88, *) ' sweep2 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 (ll_debug) THEN
+              IF (endlon .eq. beglon) THEN
+                  WRITE(88,1113) beglon, beglat 
+                  WRITE(88,1114) endlon, endlat
+                  WRITE(88, *)'  sweep2 endlon == beglon; skip segment'
+                  WRITE(88,*) '             '
+              ENDIF
+          ENDIF
+          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
+                write(nulou,*) 'ERROR=>integration stalled:' 
+                write(nulou,*) 'num_subseg exceeded limit'
+                write(nulou,*) 'Verify corners in grids.nc, especially'
+                write(nulou,*) 'if calculated by OASIS routine corners'
+                write(nulou,*) 
+     &              'integration stalled: num_subseg exceeded limit'
+                CALL OASIS_FLUSH_SCRIP(nulou)
+                stop
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 1.
+            !***
+
+            call timer_start(6)
+            IF (ll_debug) THEN
+                WRITE(88,1115) beglon, beglat 
+                WRITE(88,1116) endlon, endlat
+                WRITE(88,*) '             '
+            ENDIF
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+            IF (ll_debug) THEN
+                WRITE(88,*) ' After call intersection, grid1_add',
+     &              grid1_add
+                WRITE(88,1117) beglon, beglat 
+                WRITE(88,1118) endlon, endlat
+                WRITE(88,1119) intrsct_lon, intrsct_lat
+                WRITE(88,*) '   '
+            ENDIF
+
+            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_lon(grid1_add),
+     &                         grid2_center_lon(grid2_add))
+
+              IF (ll_debug) THEN
+                  WRITE(88,*) '  A2) WEIGHTS for this subsegment =',
+     &                weights(1)
+                  WRITE(88,*) '     ' 
+              ENDIF
+            else
+              call line_integral(weights, num_wts,
+     &                        beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid2_center_lon(grid2_add),
+     &                         grid2_center_lon(grid2_add))
+ 
+             IF (ll_debug) THEN
+                 WRITE(88,*) '  B2) WEIGHTS for this subsegment =',
+     &                weights(1)
+                  WRITE(88,*) '     ' 
+              ENDIF
+           endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+              IF (ll_debug) THEN
+                WRITE(88,*) '  LREVERS; WEIGHTS for this subsegment =',
+     &              weights(1)
+                WRITE(88,*) '     '
+              ENDIF
+            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 (ll_debug .and. lcoinc)
+     &          WRITE(88,*) '  LCOINC is TRUE; weight not stored'
+
+            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)
+
+                   IF (ll_debug) THEN
+                   WRITE(88,*) '      after store_link_cnsrv norm2'
+                   WRITE(88,1120) grid1_add, grid2_add,beglon, beglat,
+     &   intrsct_lon,intrsct_lat,weights(1)
+                   ENDIF
+                  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)
+              else if (lfracnnei) THEN
+                  weights = 0  
+                  call store_link_cnsrv(grid1_add, grid2_add, weights)
+                        IF (ll_debug) THEN
+           WRITE(88,*) '      after store_link_cnsrv fracnnei2'
+           WRITE(88,1122) grid1_add, grid2_add,beglon, beglat,
+     &   intrsct_lon,intrsct_lat,weights(1)
+                        ENDIF
+              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
+
+          END if
+
+          !***
+          !*** 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)
+#ifdef TREAT_OVERLAY
+      deallocate(grid2_overlap)
+#endif
+      IF (nlogprt .GE. 2) THEN
+          WRITE(nulou,*) 'grid2 end sweep '
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+
+      IF (ll_debug) THEN
+          do n=1,num_links_map1
+            WRITE(88,*) 'grid1, grid2, weight= ',
+     &      grid1_add_map1(n), grid2_add_map1(n), wts_map1(1,n)
+          END DO
+      ENDIF
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      IF (nlogprt .GE. 2) THEN
+          WRITE(nulou,*) 'Total number of links = ',num_links_map1
+          CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+
+      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 (nlogprt .GE. 2) THEN
+            if (grid1_area(n) < -.01) then
+                WRITE(nulou,*) 'Grid 1 area error: n, area, mask ='
+     &              ,n,grid1_area(n), grid1_mask(n)
+            endif
+            if (grid1_centroid_lat(n) < -pih-.01 .or.
+     &          grid1_centroid_lat(n) >  pih+.01) then
+                WRITE(nulou,*)'Grid1 centroid lat error: 
+     &n, centroid_lat, mask='
+     &          ,n,grid1_centroid_lat(n), grid1_mask(n)
+            endif
+            CALL OASIS_FLUSH_SCRIP(nulou)
+        ENDIF
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        IF (nlogprt .GE. 2) THEN
+            if (grid2_area(n) < -.01) then
+                WRITE(nulou,*) 'Grid 2 area error:  n, area, mask ='
+     &              ,n,grid2_area(n), grid2_mask(n)
+            endif
+            if (grid2_centroid_lat(n) < -pih-.01 .or.
+     &          grid2_centroid_lat(n) >  pih+.01) then
+                WRITE(nulou,*) 'Grid 2 centroid lat error: 
+     &n, centroid_lat, mask='
+     &          ,n,grid2_centroid_lat(n), grid2_mask(n)
+            endif
+            CALL OASIS_FLUSH_SCRIP(nulou)
+        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 (nlogprt .GE. 2) THEN        
+            if (wts_map1(1,n) < -.01) THEN
+                write(nulou,*)'Map 1 weight < 0 '
+                WRITE(NULOU,*)
+     &         'grid1_add, grid2_add, wts_map1, grid1_mask, grid2_mask',
+     &              grid1_add, grid2_add, wts_map1(1,n), 
+     &              grid1_mask(grid1_add), grid2_mask(grid2_add)
+            endif
+            if (norm_opt/=norm_opt_none .and. wts_map1(1,n)>1.01) then
+                write(nulou,*)'Map 1 weight > 1 '
+                WRITE(NULOU,*)
+     &        'grid1_add, grid2_add, wts_map1, grid1_mask, grid2_mask',
+     &              grid1_add, grid2_add, wts_map1(1,n), 
+     &              grid1_mask(grid1_add), grid2_mask(grid2_add) 
+            endif
+        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 '
+!            PRINT *,
+!     &          'grid1_add,grid2_add, wts_map2, grid1_mask, grid2_mask',
+!     &          grid1_add, grid2_add, wts_map2(1,n), 
+!     &          grid1_mask(grid1_add), grid2_mask(grid2_add) 
+!          endif
+!          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+!            print *,'Map 2 weight < 0 '
+!            PRINT *,
+!     &          'grid1_add,grid2_add,wts_map2, grid1_mask,grid2_mask',
+!     &          grid1_add, grid2_add, wts_map2(1,n), 
+!     &          grid1_mask(grid1_add), grid2_mask(grid2_add) 
+!          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(n)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(n)
+          else
+            norm_factor = grid2_area(n)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(n)-norm_factor) > .01) then
+          print *,
+     &'Error sum wts map1:grid2_add,grid2_centroid_lat,norm_factor='
+     &,n,grid2_centroid_lat(n),
+     &norm_factor,grid2_mask(n)
+        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(n)
+!          case (norm_opt_frcarea)
+!            norm_factor = one
+!          case (norm_opt_none)
+!            if (luse_grid1_area) then
+!              norm_factor = grid1_area_in(n)
+!            else
+!              norm_factor = grid1_area(n)
+!            endif
+!          end select
+!          if (abs(grid1_centroid_lat(n)-norm_factor) > .01) then
+!            print *,
+!     &'Error sum wts map2:grid1_add,grid1_centroid_lat,norm_factor='
+!     &,n,grid1_centroid_lat(n),
+!     &norm_factor,grid1_mask(n)
+!          endif
+!        end do
+!      endif
+
+!-----------------------------------------------------------------------
+!
+!     deallocate allocated arrays
+!
+!----------------------------------------------------------------------- 
+
+      deallocate (grid1_centroid_lat, grid1_centroid_lon,
+     &            grid2_centroid_lat, grid2_centroid_lon)
+
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine remap_conserv'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      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
+! for test of non-convexe cell
+      integer (kind=int_kind) :: next2_n, neg, pos  
+
+      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
+     &     rl_halfpi, rl_v2lonmpi2, rl_v2lonppi2
+
+      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
+               !*** do a test to see if the cell really is outside 
+               !*** or if it is a non-convexe cell 
+               neg=0
+               pos=0
+               do n=1,srch_corners
+                  next_n = MOD(n,srch_corners) + 1
+                  next2_n = MOD(next_n,srch_corners) + 1
+
+                  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 = srch_corner_lat(next2_n,cell) - 
+     &                 srch_corner_lat(next_n,cell)
+                  vec2_lon =  srch_corner_lon(next2_n,cell) - 
+     &                 srch_corner_lon(next_n,cell)
+                  
+                  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_lat*vec2_lon - vec2_lat*vec1_lon
+
+                  if (cross_product < zero) then
+                     neg=neg+1
+                  else if (cross_product > zero) then
+                     pos=pos+1
+                  endif
+               enddo
+               !*** the cell is non-convexe if not all cross_products 
+               !*** have the same signe
+               if (neg/=0 .and. pos/=0) then
+                  loutside=.false.
+                  IF (nlogprt .ge. 2) THEN
+                      write(nulou,*) 'The mesh ',srch_add(cell),
+     $                    ' is non-convex'
+                      write(nulou,*) 'srch_corner_lat=',
+     $                    srch_corner_lat(:,cell)
+                      write(nulou,*) 'srch_corner_lon=',
+     $                    srch_corner_lon(:,cell)
+                      CALL OASIS_FLUSH_SCRIP(nulou)
+                  ENDIF
+               endif
+            endif
+            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
+
+      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_lon, 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_lon, ! reference coordinates for each
+     &     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
+      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
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+!SV      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        if (.not. first_conserv) then
+          deallocate(link_add1, link_add2)
+        endif
+        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: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_distwgt.F
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_distwgt.F	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_distwgt.F	(revision 4775)
@@ -0,0 +1,547 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C**** 
+C**********************************************************************
+C     This module belongs to the SCRIP library. It is modified to run
+C     within OASIS. 
+C     Modifications:
+C       - restrict types are written in capital letters
+C       - bug line 386: bin_lons(3,n) instead of bin_lons(2,n)
+C
+C     Modified by            V. Gayler,  M&D                  20.09.2001
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.F 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      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
+      LOGICAL, parameter :: ll_nnei=.true.
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt (lextrapdone, num_neighbors)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+
+      INTEGER (kind=int_kind) ::
+     &       num_neighbors     ! number of neighbours
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) ::
+     &    nbr_mask             ! mask at nearest neighbors
+      logical (kind=log_kind) :: ll_debug  ! for debug outputs
+
+      integer (kind=int_kind) :: n,
+     &     dst_add,        ! destination address
+     &     nmap,           ! index of current map being computed
+     &     icount          ! number of non masked nearest neighbour
+
+      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)
+
+      real (kind=dbl_kind) :: dl_test
+
+      integer (kind=int_kind) :: src_addnn, il_debug_add
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine remap_distwgt'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+      dl_test = 0.0
+      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
+        !*** or non masked nearest neighbour
+        !*** and distances to each point
+        !***
+
+        call grid_search_nbr(src_addnn,
+     &                       nbr_add, nbr_dist, 
+     &                       grid2_center_lat(dst_add),
+     &                       grid2_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr1, num_neighbors,lextrapdone,
+     &                       dst_add)
+        ll_debug = .false.
+        IF (ll_debug) THEN
+            il_debug_add = 15248
+            IF (dst_add == il_debug_add) THEN 
+                WRITE(nulou,*) 'nbr_add = ', nbr_add(:)
+                WRITE(nulou,*) 'nbr_dist = ', nbr_dist(:)
+                CALL OASIS_FLUSH_SCRIP(nulou)
+            ENDIF
+        ENDIF
+
+        !***
+        !*** 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)) .or. lextrapdone) then
+            nbr_dist(n) = one/(nbr_dist(n) + epsilon(dl_test))
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end DO
+        IF (ll_debug) THEN
+            IF (dst_add == il_debug_add) THEN 
+                WRITE(nulou,*) 'nbr_mask = ', nbr_mask(:)
+                WRITE(nulou,*) 'nbr_dist = ', nbr_dist(:)
+                WRITE(nulou,*) 'dist_tot = ', dist_tot
+            endif 
+        ENDIF
+
+        !***
+        !*** normalize weights and store the link
+        !***
+        icount = 0
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            IF (ll_debug) THEN       
+                IF (dst_add == il_debug_add) THEN 
+                    WRITE(nulou,*) 'wgtstmp = ', wgtstmp(1)
+                    WRITE(nulou,*) 'nbr_dist = ', nbr_dist(:)
+                ENDIF
+            ENDIF
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+            icount = icount + 1
+          endif
+        end do
+        IF (ll_nnei) then
+        if (icount == 0) THEN
+            IF (nlogprt .ge. 2) then
+                WRITE(nulou,*) '    '
+                WRITE(nulou,*) 
+     & 'Using the nearest non-masked neighbour because all 4 
+     &  surrounding source points are masked for target point ',dst_add
+                CALL OASIS_FLUSH_SCRIP(nulou)
+            ENDIF
+            wgtstmp(1) = 1.
+            grid2_frac(dst_add) = one
+            call store_link_nbr(src_addnn, dst_add, wgtstmp, nmap)
+        ENDIF
+        endif
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      deallocate(wgtstmp)
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine remap_distwgt'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(src_addnn, 
+     &               nbr_add, nbr_dist, plat, plon, 
+     &               coslat_dst, coslon_dst, sinlat_dst, sinlon_dst,
+     &               src_bin_add, num_neighbors, lextrapdone, dst_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add            ! search bins for restricting search
+
+      integer (kind=int_kind), intent(in) :: dst_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
+
+      INTEGER (kind=int_kind) ::
+     &       num_neighbors     ! number of neighbours
+
+      LOGICAL ::
+     &           lextrapdone,   ! logical, true if EXTRAP done on field
+     &           ll_debug
+     
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      integer (kind=int_kind), intent(out) :: src_addnn
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk, ! dummy indices
+     &        min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1,
+     &        il_debug_add
+
+      real (kind=dbl_kind) ::
+     &        distance, arg, src_latsnn      ! 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(2,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
+      src_latsnn = bignum
+      src_addnn = 0
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+        arg = sinlat_dst*sinlat(nadd) +
+     &        coslat_dst*coslat(nadd)*
+     &       (coslon_dst*coslon(nadd) + sinlon_dst*sinlon(nadd))
+        IF (arg < -1.0d0) THEN
+            arg = -1.0d0
+        ELSE IF (arg > 1.0d0) THEN
+            arg = 1.0d0
+        END IF
+        distance = acos(arg)
+        ll_debug = .false.
+        IF (ll_debug) THEN
+            il_debug_add = 15248
+            IF (dst_add == il_debug_add) THEN
+                WRITE(nulou,1009) nadd, distance
+            ENDIF
+        ENDIF
+        !***
+        !*** 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
+        IF (ll_debug) THEN
+            IF (dst_add == il_debug_add) THEN
+                WRITE(nulou,1010) nadd, distance
+            ENDIF
+        ENDIF
+        !
+        IF (ll_nnei) then
+        !***
+        !*** store the non-masked closest neighbour
+        !***
+        if (distance < src_latsnn) THEN
+            if (grid1_mask(nadd) .or. lextrapdone) THEN
+                src_addnn = nadd
+                src_latsnn = distance
+            ENDIF
+            IF (ll_debug) THEN
+                IF (dst_add == il_debug_add) THEN
+                    WRITE(nulou,1010) nadd, distance
+                ENDIF
+            ENDIF        
+        ENDIF
+        endif
+      end DO
+ 1009 FORMAT (1X, 'nadd0 =', 1X, I6, 2X, 'distance0 =', 1X, F18.16)
+ 1010 FORMAT (1X, 'nadd1 =', 1X, I6, 2X, 'distance0 =', 1X, F18.16)
+ 1011 FORMAT (1X, 'nadd2 =', 1X, I6, 2X, 'distance2 =', 1X, F18.16)
+
+!-----------------------------------------------------------------------
+
+      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: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_gauswgt.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_gauswgt.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_gauswgt.f	(revision 4775)
@@ -0,0 +1,812 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C**** 
+C***********************************************************************
+C     This module belongs to the SCRIP library. It is a modified version
+C     of SCRIP 1.4 remap_ditswgt.f in order to weight a neighbour by
+C     exp[-1/2 * d^^2/sigma^^2] where d is the distance between the source
+C     and the target points and sigma^^2=VAR*dm^^2, where dm is the
+C     average distance between the source grid points and VAR is a value 
+C     given by the user.
+C
+C     Additional Modifications:
+C       - restrict types are written in capital letters
+C       - bug line 429: bin_lons(3,n) instead of bin_lons(2,n)
+C
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_gauswgt.f 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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_gaussian_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
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      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_gauswgt (lextrapdone, num_neighbors, rl_varmul)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+
+      REAL (kind=real_kind) ::
+     $    rl_varmul             ! Gaussian variance
+
+      INTEGER (kind=int_kind) ::
+     &       num_neighbors     ! number of neighbours
+
+!-----------------------------------------------------------------------
+!
+!     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)
+     &     dist_average    ! average distance between the source points
+      logical (kind=log_kind) :: ll_allmask
+      logical (kind=log_kind), PARAMETER :: ll_nnei=.true.
+      real (kind=dbl_kind) ::
+     &        distance ,plat,plon,src_latsnn, arg   ! angular distance
+      real (kind=dbl_kind), dimension (1) :: wgts_new
+      integer (kind=int_kind) :: min_add_out, max_add_out, 
+     &        srch_add, src_addnn
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine remap_gauswgt'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!-----------------------------------------------------------------------
+!
+!     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)
+
+      !***
+      !*** compute the average of the distances between the source points
+      !*** 
+
+      call grid_dist_average(grid1_size,
+     &                       coslat, coslon,
+     &                       sinlat, sinlon,
+     &                       dist_average)
+      !***
+      !*** 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_nbrg(nbr_add, nbr_dist, 
+     &                        min_add_out, max_add_out,
+     &                        grid2_center_lat(dst_add),
+     &                        grid2_center_lon(dst_add),
+     &                        coslat_dst, coslon_dst, 
+     &                        sinlat_dst, sinlon_dst,
+     &                        bin_addr1, 
+     &                        dist_average,  num_neighbors, rl_varmul)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+        src_addnn = zero
+        dist_tot = zero
+        do n=1,num_neighbors
+          if ((grid1_mask(nbr_add(n))) .or.
+     &        (.not. grid1_mask(nbr_add(n)) .and. lextrapdone)) 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
+        IF (ll_nnei) THEN
+            ll_allmask= .true.
+            do n=1,num_neighbors
+              if (nbr_mask(n)) then
+                  ll_allmask=.false.
+              endif
+            end do
+            if ( ll_allmask) THEN
+                src_latsnn = bignum
+                do srch_add = min_add_out,max_add_out
+                  if (grid1_mask(srch_add) .or.
+     &                (.not. grid1_mask(srch_add) 
+     &                .and. lextrapdone)) THEN
+                      arg = coslat_dst*cos(grid1_center_lat(srch_add))*
+     &                (coslon_dst*cos(grid1_center_lon(srch_add)) +
+     &                sinlon_dst*sin(grid1_center_lon(srch_add)))+
+     &                sinlat_dst*sin(grid1_center_lat(srch_add))
+                      IF (arg < -1.0d0) THEN
+                          arg = -1.0d0
+                      ELSE IF (arg > 1.0d0) THEN
+                          arg = 1.0d0
+                      END IF
+                      distance=acos(arg)
+                      
+                      if (distance < src_latsnn) then
+                          src_addnn = srch_add
+                          src_latsnn = distance
+                      endif
+                  endif
+                end do
+                IF (nlogprt .GE. 2) THEN
+                    WRITE(nulou,*)'ll_allmask=true and src_addnn= '
+     &                  ,src_addnn
+                    CALL OASIS_FLUSH_SCRIP(nulou)
+                ENDIF
+                wgts_new(1) = 1.
+                grid2_frac(dst_add) = one
+                call store_link_nbr(src_addnn,dst_add ,wgts_new, nmap)
+            endif
+        endif
+            
+      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)
+
+      !***
+      !*** compute the average of the distances between the source points
+      !*** 
+
+      call grid_dist_average(grid2_size,
+     &                       coslat, coslon,
+     &                       sinlat, sinlon,
+     &                       dist_average)
+
+      !***
+      !*** 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_nbrg(nbr_add, nbr_dist, 
+     &                        min_add_out, max_add_out,
+     &                        grid1_center_lat(dst_add),
+     &                        grid1_center_lon(dst_add),
+     &                        coslat_dst, coslon_dst, 
+     &                        sinlat_dst, sinlon_dst,
+     &                        bin_addr2, 
+     &                        dist_average, num_neighbors, rl_varmul)
+
+        !***
+        !*** 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
+
+        IF (ll_nnei) THEN
+            ll_allmask= .true.
+            do n=1,num_neighbors
+              if (nbr_mask(n)) then
+                  ll_allmask=.false.
+              endif
+            end do
+            if ( ll_allmask) then
+                PRINT*, 'll_allmask true',src_addnn   
+                src_latsnn = bignum
+                do srch_add = min_add_out,max_add_out
+                  if (grid2_mask(srch_add) .or.
+     &                (.not. grid2_mask(srch_add) 
+     &                .and. lextrapdone)) THEN
+                      arg = coslat_dst*cos(grid2_center_lat(srch_add))*
+     &                (coslon_dst*cos(grid2_center_lon(srch_add)) +
+     &                sinlon_dst*sin(grid2_center_lon(srch_add)))+
+     &                sinlat_dst*sin(grid2_center_lat(srch_add))
+                      IF (arg < -1.0d0) THEN
+                          arg = -1.0d0
+                      ELSE IF (arg > 1.0d0) THEN
+                          arg = 1.0d0
+                      END IF
+                      distance=acos(arg)
+
+                      if (distance < src_latsnn) then
+                          src_addnn = srch_add
+                          src_latsnn = distance
+                      endif
+                  endif
+                end do
+                wgts_new = 1.
+                grid1_frac(dst_add) = one
+                call store_link_nbr(dst_add, src_addnn, wgts_new, nmap)
+            endif
+        endif
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine remap_gauswgt'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      end subroutine remap_gauswgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbrg(nbr_add, nbr_dist, min_add, max_add, 
+     &               plat, plon,  
+     &               coslat_dst, coslon_dst, sinlat_dst, sinlon_dst,
+     &               src_bin_add, dst_average,
+     $               num_neighbors, rl_varmul)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add ! search bins for restricting search
+
+      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
+     &        dst_average   ! average distance between the source points
+
+      REAL (kind=real_kind), intent(in) ::
+     &        rl_varmul     ! Gaussian variance
+
+      INTEGER (kind=int_kind) ::
+     &       num_neighbors     ! number of neighbours
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+      integer (kind=int_kind),intent(out) :: min_add, max_add 
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk, ! dummy indices
+     &        nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) ::
+     &        distance, arg      ! angular distance
+
+      real (kind=dbl_kind) ::
+     &        variance      ! variance for the gaussian FUNCTION
+
+
+!-----------------------------------------------------------------------
+!
+!     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(2,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
+      variance = rl_varmul*dst_average*dst_average
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+        arg = sinlat_dst*sinlat(nadd) +
+     &        coslat_dst*coslat(nadd)*
+     &       (coslon_dst*coslon(nadd) +
+     &        sinlon_dst*sinlon(nadd))
+        IF (arg < -1.0d0) THEN
+            arg = -1.0d0
+        ELSE IF (arg > 1.0d0) THEN
+            arg = 1.0d0
+        END IF
+        distance = acos(arg)
+        !distance = min(500., distance) !ts-sv
+        !distance = exp(.5*distance*distance/variance)
+        !***
+        !*** 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
+
+      exp_loop: do nchk=1,num_neighbors
+          nbr_dist(nchk) = 
+     &     exp(.5*nbr_dist(nchk)*nbr_dist(nchk)/variance)
+      end do exp_loop
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbrg 
+
+!***********************************************************************
+
+      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
+
+!***********************************************************************
+
+      subroutine grid_dist_average(grid_size,
+     &                             coslat_grid, coslon_grid,
+     &                             sinlat_grid, sinlon_grid,
+     &                             dist_average)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the average distance between the points of a
+!     grid.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(out) ::
+     &        dist_average ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        grid_size  
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        coslat_grid,   ! cos(lat)  of the grid points
+     &        coslon_grid,   ! cos(lon)  of the grid points
+     &        sinlat_grid,   ! sin(lat)  of the grid points
+     &        sinlon_grid    ! sin(lon)  of the grid points
+      REAL (kind=dbl_kind) :: arg
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)
+     &       'Entering routine remap_dist_average'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     compute the distance over the grid and average
+!
+!-----------------------------------------------------------------------
+
+      dist_average = 0.0
+      DO i = 1, grid_size
+        IF (i .eq. 1) THEN
+            arg = sinlat_grid(grid_size)*sinlat_grid(i) +
+     &          coslat_grid(grid_size)*coslat_grid(i)*
+     &          (coslon_grid(grid_size)*coslon_grid(i) +
+     &          sinlon_grid(grid_size)*sinlon_grid(i))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF           
+            dist_average = dist_average + acos(arg)
+
+            arg = sinlat_grid(i)*sinlat_grid(i+1) +
+     &          coslat_grid(i)*coslat_grid(i+1)*
+     &          (coslon_grid(i)*coslon_grid(i+1) +
+     &          sinlon_grid(i)*sinlon_grid(i+1))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF 
+            dist_average = dist_average + acos(arg)
+             
+        ELSE IF (i .eq. grid_size) THEN
+            arg = sinlat_grid(i-1)*sinlat_grid(i) +
+     &          coslat_grid(i-1)*coslat_grid(i)*
+     &          (coslon_grid(i-1)*coslon_grid(i) +
+     &          sinlon_grid(i-1)*sinlon_grid(i))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF 
+            dist_average = dist_average + acos(arg)
+
+            arg = sinlat_grid(i)*sinlat_grid(1) +
+     &          coslat_grid(i)*coslat_grid(1)*
+     &          (coslon_grid(i)*coslon_grid(1) +
+     &          sinlon_grid(i)*sinlon_grid(1))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF 
+            dist_average = dist_average + acos(arg)
+            
+        ELSE
+            arg = sinlat_grid(i-1)*sinlat_grid(i) +
+     &          coslat_grid(i-1)*coslat_grid(i)*
+     &          (coslon_grid(i-1)*coslon_grid(i) +
+     &          sinlon_grid(i-1)*sinlon_grid(i))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF             
+            dist_average = dist_average + acos(arg)
+
+            arg = sinlat_grid(i)*sinlat_grid(i+1) +
+     &          coslat_grid(i)*coslat_grid(i+1)*
+     &          (coslon_grid(i)*coslon_grid(i+1) +
+     &          sinlon_grid(i)*sinlon_grid(i+1))
+            IF (arg < -1.0d0) THEN
+                arg = -1.0d0
+            ELSE IF (arg > 1.0d0) THEN
+                arg = 1.0d0
+            END IF              
+            dist_average = dist_average + acos(arg)             
+        END IF
+      END DO
+      dist_average = dist_average / (2*grid_size)
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)
+     &       'Leaving routine remap_dist_average'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      END subroutine grid_dist_average
+
+!***********************************************************************
+
+      end module remap_gaussian_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_vars.F
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_vars.F	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_vars.F	(revision 4775)
@@ -0,0 +1,439 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C****
+C***********************************************************************
+C     This module belongs to the SCRIP library. It is modified to run
+C     within OASIS. 
+C     Modifications:
+C       - introduction of logical flags to allow multiple calls of SCRIP
+C       - deallocation of arrays not needed any more
+C       - added CASE for GAUSWGT
+C
+C     Modified by            V. Gayler,  M&D                  20.09.2001
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.F 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &      norm_opt_none    = 1
+     &,     norm_opt_dstarea = 2
+     &,     norm_opt_frcarea = 3
+     &,     norm_opt_nonorm  = 4
+
+      integer (kind=int_kind), parameter ::
+     &      map_type_conserv  = 1
+     &,     map_type_bilinear = 2
+     &,     map_type_bicubic  = 3
+     &,     map_type_distwgt  = 4
+     &,     map_type_gauswgt  = 5
+
+      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
+#ifdef TREAT_OVERLAY
+      INTEGER (kind=int_kind), dimension(:), allocatable, save ::
+     &      grid1_add_repl1 ! grid1 address to use after overlap calculation
+#endif TREAT_OVERLAY
+      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)
+
+      logical (kind=log_kind), save :: lfracnnei = .false.
+ 
+      logical (kind=log_kind), save :: first_conserv = .true. ! flag to 
+                                ! indicate, whether scrip is called from
+                                ! oasis for the first time
+      logical (kind=log_kind), save :: first_call = .true. ! flag used in
+                                ! remap_conserve (store_link_cnsrv)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars (id_scripvoi)
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      INTEGER (kind=int_kind)::
+     &     id_scripvoi          ! number of neighbours for DISTWGT and GAUSWGT
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine init_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     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)
+          IF (restrict_type == 'REDUCED') THEN
+              num_wts = 1
+          ELSE
+              num_wts = 4
+          ENDIF
+      case(map_type_distwgt)
+        num_wts = 1
+      case(map_type_gauswgt)
+        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
+      select case (map_type)
+      case(map_type_conserv)
+          max_links_map1 = 4*grid2_size
+      case(map_type_bilinear)
+          max_links_map1 = 4*grid2_size
+      case(map_type_bicubic)
+          IF (restrict_type == 'REDUCED') THEN
+              max_links_map1 = 16*grid2_size
+          ELSE
+              max_links_map1 = 4*grid2_size
+          ENDIF
+      case(map_type_distwgt)
+          max_links_map1 = id_scripvoi*grid2_size
+      case(map_type_gauswgt)
+          max_links_map1 = id_scripvoi*grid2_size
+      END select
+
+      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))
+#ifdef TREAT_OVERLAY
+      allocate (grid1_add_repl1(grid1_size))
+#endif TREAT_OVERLAY
+
+!-----------------------------------------------------------------------
+!
+!     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
+!-----------------------------------------------------------------------
+!
+!     initialize flag for routine store_link_cnsrv
+!   
+!-----------------------------------------------------------------------
+      first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine init_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      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
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)
+     &       'Entering routine resize_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     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
+            WRITE(nulou,*) '   '
+            WRITE(nulou,*)'error allocating temps in resize: ',ierr
+            CALL OASIS_FLUSH_SCRIP(nulou)
+            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
+            WRITE(nulou,*) '   '
+            WRITE(nulou,*)'error allocating new arrays in resize: ',ierr
+            CALL OASIS_FLUSH_SCRIP(nulou)
+            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
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)
+     &       'Leaving routine resize_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+!----------------------------------------------------------------------- 
+!----------------------------------------------------------------------- 
+      subroutine free_remap_vars
+!-----------------------------------------------------------------------
+!
+!     subroutine to deallocate allocated arrays
+!
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine free_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+      deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+#ifdef TREAT_OVERLAY
+      deallocate (grid1_add_repl1)
+#endif TREAT_OVERLAY
+
+      if (num_maps > 1) then
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+      if (map_type == map_type_conserv) then
+        first_call = .true.
+        first_conserv = .false.
+      endif
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine free_remap_vars'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      end subroutine free_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_write.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_write.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/remap_write.f	(revision 4775)
@@ -0,0 +1,1618 @@
+C****
+C                    ************************
+C                    *     OASIS MODULE     *
+C                    *     ------------     *
+C                    ************************
+C**** 
+C***********************************************************************
+C     This module belongs to the SCRIP library. It is modified to run
+C     within OASIS. 
+C     Modifications:
+C       - Added CASE for GAUSWGT
+C
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     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 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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
+      USE mod_oasis_flush
+
+      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
+      integer (kind=int_kind), private ::
+     &   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
+!
+!-----------------------------------------------------------------------
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine write_remap '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+      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'
+      case (norm_opt_nonorm)
+        normalize_opt = 'no norm'
+      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_gauswgt)
+        map_method = 'Gaussian 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)
+
+!-----------------------------------------------------------------------
+!
+!     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
+
+!-----------------------------------------------------------------------
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine write_remap '
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      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
+
+      integer (kind=int_kind) :: il_nftype
+!-----------------------------------------------------------------------
+      IF (nlogprt .GE. 2) THEN
+       WRITE (UNIT = nulou,FMT = *)' '
+       WRITE (UNIT = nulou,FMT = *)'Entering routine write_remap_scrip '
+       CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!-----------------------------------------------------------------------
+!
+!     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
+      !***
+
+      il_nftype = NF_DOUBLE
+      IF (ll_single) il_nftype = NF_REAL
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat', 
+     &                     il_nftype, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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
+      IF (ll_single) THEN
+          ncstat=nf_put_var_real(nc_file_id, itmp1, grid1_center_lat)
+      ELSE
+          ncstat=nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      ENDIF
+      call netcdf_error_handler(ncstat)
+
+      IF (ll_single) THEN
+          ncstat=nf_put_var_real(nc_file_id, itmp2, grid1_center_lon)
+      ELSE
+          ncstat=nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      ENDIF
+      call netcdf_error_handler(ncstat)
+
+      if (.not. luse_grid_centers) THEN
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp3, 
+     $            grid1_corner_lat)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp3, 
+     $            grid1_corner_lat)
+          ENDIF
+          call netcdf_error_handler(ncstat)
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp4, 
+     $            grid1_corner_lon)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp4, 
+     $            grid1_corner_lon)
+          ENDIF
+          call netcdf_error_handler(ncstat)
+      endif
+
+      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
+      
+      IF (ll_single) THEN
+          ncstat=nf_put_var_real(nc_file_id, itmp1, grid2_center_lat)
+      ELSE
+          ncstat=nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      ENDIF
+      call netcdf_error_handler(ncstat)
+
+      IF (ll_single) THEN
+          ncstat=nf_put_var_real(nc_file_id, itmp2, grid2_center_lon)
+      ELSE
+          ncstat=nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      ENDIF
+      call netcdf_error_handler(ncstat)
+
+      if (.not. luse_grid_centers) THEN
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp3, 
+     $            grid2_corner_lat)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp3, 
+     $            grid2_corner_lat)
+          ENDIF
+          call netcdf_error_handler(ncstat)
+
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp4, 
+     $            grid2_corner_lon)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp4, 
+     $            grid2_corner_lon)
+          ENDIF
+          call netcdf_error_handler(ncstat)
+
+      endif
+      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
+          IF (ll_single) THEN
+              ncstat=nf_put_var_real(nc_file_id, itmp1, grid1_area_in)
+          ELSE
+              ncstat=nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+          ENDIF
+      ELSE
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp1, grid1_area)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+          ENDIF
+      endif
+      call netcdf_error_handler(ncstat)
+
+      IF (ll_single) THEN
+          ncstat = nf_put_var_real(nc_file_id, itmp2, grid1_frac)
+      ELSE
+          ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      ENDIF
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) THEN
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real
+     $            (nc_file_id, itmp3, grid2_area_in)
+          ELSE
+              ncstat = nf_put_var_double
+     $            (nc_file_id, itmp3, grid2_area_in)
+          ENDIF
+      ELSE
+          IF (ll_single) THEN
+              ncstat = nf_put_var_real(nc_file_id, itmp3, grid2_area)
+          ELSE
+              ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+          ENDIF
+      endif
+      call netcdf_error_handler(ncstat)
+
+      IF (ll_single) THEN
+          ncstat = nf_put_var_real(nc_file_id, itmp4, grid2_frac)
+      ELSE
+          ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      ENDIF
+      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 (ll_single) THEN
+            ncstat = nf_put_var_real(nc_file_id, nc_rmpmatrix_id, 
+     &          wts_map1)
+        ELSE
+            ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &          wts_map1)
+        ENDIF
+        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)
+        IF (ll_single) THEN
+            ncstat = nf_put_var_real(nc_file_id, nc_rmpmatrix_id, 
+     &          wts_map2)
+        ELSE
+            ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &          wts_map2)
+        ENDIF
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+!
+      IF (nlogprt .GE. 2) THEN
+       WRITE (UNIT = nulou,FMT = *)' '
+       WRITE (UNIT = nulou,FMT = *)'Leaving routine write_remap_scrip '
+       CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!-----------------------------------------------------------------------
+
+      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
+
+      integer (kind=int_kind) :: il_nftype
+
+      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
+      !***
+
+      il_nftype = NF_DOUBLE
+      IF (ll_single) il_nftype = NF_REAL
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a',
+     &                     il_nftype, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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', 
+     &                     il_nftype, 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
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/scrip.F
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/scrip.F	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/scrip.F	(revision 4775)
@@ -0,0 +1,540 @@
+C****
+C               *****************************
+C               * OASIS ROUTINE  -  LEVEL 1 *
+C               * -------------     ------- *
+C               *****************************
+C****
+C***********************************************************************
+C     This routine belongs to the SCRIP library. It is modified to run
+C     within OASIS.
+C     Modifications:
+C       - routine does not read namelist but gets parameters from the
+C         calling routine scriprmp.f
+C       - map-method and noralize-option are written in capital letters
+C       - routine grid_init is not called from scrip any more but was
+C         called earlier from scriprmp
+C       - call of two extra routines: free_grids and free_remap_vars to 
+C         allow multiple calls of SCRIP
+C       - added case for GAUSWGT 
+C       - added 'REDUCED' case for bilinear and bicubic.
+C       - hard coded num_maps=1 for USE in OASIS
+C       - added lextrapdone argument
+C
+C     Modified by            V. Gayler,  M&D                  20.09.2001
+C     Modified by            D. Declat,  CERFACS              27.06.2002
+C     Modified by            S. Valcke,  CERFACS              27.08.2002
+C***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f 1831 2009-01-09 17:19:08Z valcke $
+!
+!     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.
+!
+!***********************************************************************
+
+      subroutine scrip
+     $           (interp_file1, map1_name, m_method, n_opt, 
+     $            lextrapdone, rl_varmul, id_scripvoi)
+
+!-----------------------------------------------------------------------
+
+      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_gaussian_weight      ! routines for gaus-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_bilinear_reduced     ! routines for bilinear interp
+      use remap_bicubic_reduced      ! routines for bicubic interp
+      use remap_write                ! routines for remap output
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), intent(in) ::
+     &           interp_file1, ! filename for output remap data (map1)
+     &           map1_name     ! name for mapping from grid1 to grid2
+
+      character*8, intent(in) ::
+     &           m_method,     ! choice for mapping method
+     &           n_opt         ! option for normalizing weights
+
+      LOGICAL ::
+     &           lextrapdone   ! logical, true if EXTRAP done on field
+
+      REAL (kind=real_kind) ::
+     &    rl_varmul             ! Gaussian variance (for GAUSWGT)
+
+      INTEGER (kind=int_kind) ::
+     &     id_scripvoi          ! number of neighbours for DISTWGT and GAUSWGT
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &           n             ! dummy counter
+
+      character (char_len) ::
+     &           interp_file2, ! filename for output remap data (map2)
+     &           map2_name,    ! name for mapping from grid2 to grid1
+     &           output_opt,   ! option for output conventions
+     &           map_method,   ! choice for mapping method
+     &           normalize_opt ! option for normalizing weights
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine scrip'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     initialize variables of former SCRIP namelist
+!
+!-----------------------------------------------------------------------
+
+      interp_file2  = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 1
+      output_opt    = 'scrip'
+
+      map_method = m_method
+      normalize_opt = n_opt
+
+      select case(map_method)
+      case ('CONSERV')
+        map_type = map_type_conserv
+      case ('BILINEAR')
+        map_type = map_type_bilinear
+      case ('BICUBIC')
+        map_type = map_type_bicubic
+      case ('DISTWGT')
+        map_type = map_type_distwgt
+      case ('GAUSWGT')
+        map_type = map_type_gauswgt
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      SELECT CASE (normalize_opt)
+      CASE ('FRACNNEI')
+          lfracnnei = .true.
+      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 ('NONO')
+        norm_opt = norm_opt_nonorm
+      case default
+        stop 'unknown normalization option'
+      end select
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' Computing remappings between: '
+     &        ,grid1_name
+         WRITE (UNIT = nulou,FMT = *)'                          and  '
+     &       ,grid2_name
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+      call init_remap_vars (id_scripvoi)
+!-----------------------------------------------------------------------
+!
+!     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)
+          IF (restrict_TYPE == 'REDUCED') then
+              call remap_bilin_reduced (lextrapdone)
+          ELSE
+              call remap_bilin (lextrapdone)
+          endif
+      case(map_type_distwgt)
+          call remap_distwgt (lextrapdone, id_scripvoi)
+      case(map_type_gauswgt)
+          call remap_gauswgt (lextrapdone, id_scripvoi, rl_varmul)
+      case(map_type_bicubic)
+          IF (restrict_TYPE == 'REDUCED') then
+              call remap_bicub_reduced (lextrapdone)
+          ELSE
+              call remap_bicub (lextrapdone)
+          endif
+       case default
+           stop 'Invalid Map Type'
+      end select
+      
+      CALL sort_add(grid2_add_map1, grid1_add_map1, wts_map1,
+     $   num_links_map1, num_wts)
+      IF (lfracnnei) THEN
+          CALL fracnnei(grid1_size, grid2_size, grid1_mask, grid2_mask,
+     $        grid1_center_lon, grid1_center_lat,
+     $        grid2_center_lon, grid2_center_lat,
+     $        num_links_map1, num_wts,
+     $        wts_map1, grid1_add_map1, grid2_add_map1)
+          lfracnnei = .false.
+      ENDIF
+!
+#ifdef TREAT_OVERLAY
+!
+! Change address if overlap point were found
+      IF (map_type == 1) THEN
+          DO n = 1, num_links_map1
+            IF (grid1_add_map1(n) .ne. 0) THEN
+                grid1_add_map1(n) = grid1_add_repl1(grid1_add_map1(n))
+            ENDIF
+          END DO
+      ENDIF
+!
+#endif
+!
+!
+!-----------------------------------------------------------------------
+!
+!     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)
+
+!-----------------------------------------------------------------------
+!
+!     deallocate allocatable arrays
+!
+!-----------------------------------------------------------------------
+
+      call free_grids
+      call free_remap_vars
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine scrip'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!-----------------------------------------------------------------------!
+      end subroutine scrip
+!
+      subroutine sort_add(add1, add2, weights, num_links, num_wts)
+
+!-----------------------------------------------------------------------
+!
+!     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
+      USE mod_oasis_flush
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: num_links, num_wts
+      integer (kind=int_kind), intent(inout), dimension(num_links) ::
+     &        add1,       ! destination address array (num_links)
+     &        add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout),
+     &    dimension(num_wts, num_links) ::
+     &        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
+!-----------------------------------------------------------------------
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Entering routine sort_add'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+!
+!     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 (:)
+!
+      IF (nlogprt .GE. 2) THEN
+         WRITE (UNIT = nulou,FMT = *)' '
+         WRITE (UNIT = nulou,FMT = *)'Leaving routine sort_add'
+         CALL OASIS_FLUSH_SCRIP(nulou)
+      ENDIF
+!
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/timers.f
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/timers.f	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/scrip/src/timers.f	(revision 4775)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f 2826 2010-12-10 11:14:21Z valcke $
+!
+!     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(nulou,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(nulou,"(' 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
+        WRITE(nulou,*) '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/TopMakefileOasis3
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/TopMakefileOasis3	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/TopMakefileOasis3	(revision 4775)
@@ -0,0 +1,94 @@
+##############################################################################
+#This is the top makefile for compiling OASIS3-MCT coupling library including
+#  mct/mpeu, scrip and psmile (i.e. interpolation and communication)
+#Platform dependent settings, compiler options, cpp keys, 
+#paths and other stuff has to be set in an include file indicated in make.inc.
+# 
+# default : mct/mpeu, scrip and psmile
+# oasis3_psmile (for OASIS3 upward compatibility): mct/mpeu, scrip and psmile
+# realclean : Automatic recompilation of all sources
+#
+#######
+include make.inc
+#
+SHELL = /bin/sh
+MAKEf = $(MAKE) -f TopMakefileOasis3
+#
+# Defining path for FORTRAN and C sources
+LIBSRC  = $(COUPLE)/lib
+#
+# Log and error files for compiling
+LOG = $(COUPLE)/util/make_dir/COMP.log
+ERR = $(COUPLE)/util/make_dir/COMP.err
+#
+#######
+default: 
+	 rm -f $(LOG) $(ERR)
+	 $(MAKEf) makedirs
+	 $(MAKEf) makemct
+	 $(MAKEf) makelibs
+	 $(MAKEf) makepsmile
+#
+oasis3_psmile:
+	rm -f $(LOG) $(ERR)
+	$(MAKEf) makedirs
+	$(MAKEf) makemct
+	$(MAKEf) makelibs
+	$(MAKEf) makepsmile
+#
+realclean:
+	$(MAKEf) cleanlibs
+#
+# Rules for creating build and library directories
+#
+makedirs:
+	@mkdir -p $(ARCHDIR)/build/lib/scrip
+	@mkdir -p $(ARCHDIR)/build/lib/mctdir
+	@mkdir -p $(ARCHDIR)/build/lib/mct
+	@mkdir -p $(ARCHDIR)/build/lib/psmile.$(CHAN)
+	@mkdir -p $(ARCHDIR)/lib
+#
+# Rules for compiling mpeu/mct library
+# 
+makemct:
+	@echo "=> Compiling library mpeu and mct"
+	(cd $(ARCHDIR)/build/lib/mctdir; cp -f -r -p $(LIBSRC)/mct/* .;\
+         ./configure MPIFC="$(F90)" FC="$(F90)" CC="$(CC)" \
+         1>> $(LOG) 2>> $(ERR) ;\
+         $(MAKE) 1>> $(LOG) 2>> $(ERR) ; \
+         cp -f ./*/lib*.a   $(ARCHDIR)/lib/; \
+         cp -f ./*/*.o    $(ARCHDIR)/build/lib/mct/; \
+         cp -f ./*/*.mod  $(ARCHDIR)/build/lib/mct/;)
+#
+# Rules for compiling the libraries scrip and psmile
+#
+makelibs:
+	@echo "=> Compiling library scrip"
+	(cd $(ARCHDIR)/build/lib/scrip; cp -f $(LIBSRC)/scrip/src/Makefile .;\
+         $(modifmakefile) ; $(MAKE) all 1>> $(LOG) 2>> $(ERR) )
+
+makepsmile:
+	@echo "=> Compiling library psmile"
+	(cd $(ARCHDIR)/build/lib/psmile.$(CHAN) ; \
+         cp -f $(LIBSRC)/psmile/src/Makefile . ; $(modifmakefile) ; \
+         $(MAKE) all 1>> $(LOG) 2>> $(ERR) )
+#
+# Rules for cleaning
+#
+cleanlibs:
+	@echo cleaning oasis3-mct libraries
+	rm -f $(ARCHDIR)/build/lib/scrip/*
+	rm -f $(ARCHDIR)/build/lib/mct/*
+	rm -f -r $(ARCHDIR)/build/lib/mctdir/*
+	rm -f $(ARCHDIR)/build/lib/psmile.$(CHAN)/*
+	rm -f $(ARCHDIR)/lib/libscrip.a
+	rm -f $(ARCHDIR)/lib/libmct.a
+	rm -f $(ARCHDIR)/lib/libmpeu.a
+	rm -f $(ARCHDIR)/lib/libpsmile.$(CHAN).a
+#
+## Some rules to modify/add variables in makefiles
+#
+modifmakefile =	( echo 'include $(COUPLE)/util/make_dir/make.inc' \
+                         > infile; cat Makefile >> infile ; cp -f infile Makefile )
+#
+########################################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.aix
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.aix	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.aix	(revision 4775)
@@ -0,0 +1,69 @@
+#
+# Include file for OASIS3 Makefile adapted to  ECMWF's IBM power4 system.
+#
+###############################################################################
+#
+# CHAN : MPI1/MPI2
+CHAN            = MPI1
+# Needed to work with SCE Makefile
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+I4mods          = I
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/ibm_power4
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = /usr/lpp/ppe.poe/include/thread64 
+MPILIB      = 
+#
+#  NETCDF library
+NETCDF_INCLUDE  = /usr/local/lib/netcdf-3.5.0/LP64/include
+NETCDF_LIBRARY  = -L/usr/local/lib/netcdf-3.5.0/LP64/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = mpxlf90_r
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = mpcc_r
+LD          = $(F90)
+AR        = ar
+ARFLAGS   = r
+#
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -WF,-Duse_netCDF -WF,-Duse_comm_$(CHAN) -WF,-D__VERBOSE -WF,-DTREAT_OVERLAY
+CCPPDEF   = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+COMFLAGS  =  -Q -qarch=auto -qtune=auto -qcache=auto -qfloat=fltint -qzerosize -qlargepage -qmaxmem=-1 -q64 -O3 -qstrict -qextname
+F90FLAGS_1  = -qsuffix=cpp=F90 $(COMFLAGS) 
+f90FLAGS_1  = -qsuffix=cpp=f90 $(COMFLAGS)
+FFLAGS_1    = -qfixed -qsuffix=cpp=F $(COMFLAGS) 
+fFLAGS_1    = -qfixed -qsuffix=cpp=f $(COMFLAGS) 
+CCFLAGS_1   = $(COMFLAGS) 
+LDFLAGS   =
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) $(CCPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.beaufix
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.beaufix	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.beaufix	(revision 4775)
@@ -0,0 +1,76 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/BEAUFIX_oa3-mct
+#
+# MPI library
+MPIDIR           = /opt/softs/intel/impi/4.1.1.036/intel64
+MPIBIN           = $(MPIDIR)/bin
+MPI_INCLUDE      = $(MPIDIR)/include
+MPILIB           = -L$(MPIDIR)/lib
+#
+# NETCDF library
+NETCDF_LIB_DIR=/opt/softs/libraries/ICC13.1.4.183/netcdf-4.3.0
+NETCDF_INC_DIR=/opt/softs/libraries/ICC13.1.4.183/netcdf-4.3.0/include
+NETCDF_INCLUDE  = ${NETCDF_INC_DIR}
+NETCDF_LIBRARY  = -L${NETCDF_LIB_DIR} -lnetcdff -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpiifort -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = $(MPIBIN)/mpiicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpiifort $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE  -DTREAT_OVERLAY
+CCPPDEF   = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE  -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -O2 -xAVX -I.  -assume byterecl
+#F90FLAGS_1  = -g -traceback -O0 -check all -I. -assume byterecl
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     = 
+#
+MPP_IOOPT = -i4 -r8
+###################
+#
+
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie	(revision 4775)
@@ -0,0 +1,72 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2/NONE)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(WORKDIR)/oasis3-mct_buildbot
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(WORKDIR)/CURIE_oa3-mct
+#
+# MPI library
+#For machines in training room, put MPIDIR      = /usr/local/pgi/linux86-64/9.0/mpi/mpich/
+MPIDIR      = /opt/mpi/bullxmpi/1.1.16.5
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib
+#
+# NETCDF library
+NETCDF_INCLUDE  = ${NETCDF_INC_DIR}
+NETCDF_LIBRARY  = -L${NETCDF_LIB_DIR} -lnetcdff -lnetcdf 
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = mpicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY -DTMG_PERF
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -O2 -xAVX -I.
+#F90FLAGS_1  = -O3 -xAVX -I. -fp-model precise
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = -O2 -xAVX
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/mct -I$(LIBBUILD)/scrip
+#
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie_thin
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie_thin	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.bullx.curie_thin	(revision 4775)
@@ -0,0 +1,73 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2/NONE)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(WORKDIR)/oasis3-mct_buildbot
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(WORKDIR)/BULLX
+#
+# MPI library
+#For machines in training room, put MPIDIR      = /usr/local/pgi/linux86-64/9.0/mpi/mpich/
+MPIDIR      = /opt/mpi/bullxmpi/1.1.16.5
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib
+#
+# NETCDF library
+NETCDF_INCLUDE  = ${NETCDF_INC_DIR}
+NETCDF_LIBRARY  = -L${NETCDF_LIB_DIR} -lnetcdff -lnetcdf 
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = mpicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+#CPPDEF    = -Duse_libMPI -Duse_netCDF -Duse_comm_$(CHAN) -DDEBUG -D__VERBOSE -DTMG_PERF
+CPPDEF    = -Duse_libMPI -Duse_netCDF -Duse_comm_$(CHAN) -DTMG_PERF
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -O2 -xAVX -I.
+#F90FLAGS_1  = -O3 -xAVX -I. -fp-model precise
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = -O2 -xAVX
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/mct -I$(LIBBUILD)/scrip
+#
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.msp
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.msp	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.msp	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN : MPI1/MPI2
+CHAN            = MPI1
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+I4mods          = I
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/crayx1
+#
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+# NETCDF library msp
+NETCDF_INCLUDE  = ../netcdf/include
+NETCDF_LIBRARY  = -L../netcdf/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+#F90         = ftn
+F90         = ftn -sreal64 -dp -ra -Oscalar3,vector3,stream1,task0,inline0 -eZ -F -em -J ../module -p ../module
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = cc -O0
+LD          = ftn
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    =  -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -Ucray -UCRAY -U_CRAY -U_CRAYIEEE
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  =    -byteswapio  -O0 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   =
+LDFLAGS   = 
+#
+###################	
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.ssp
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.ssp	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayx1.ssp	(revision 4775)
@@ -0,0 +1,72 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN : MPI1/MPI2
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/crayx1
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+# NETCDF library ssp
+NETCDF_INCLUDE  = ../netcdf/include
+NETCDF_LIBRARY  = -L../netcdf/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+#F90         = ftn
+F90         = ftn -sreal64 -dp -ra -Ossp,scalar0,vector0,stream0,task0,inline0 -eZ -F -em -J ../module -p ../module
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = cc -O0
+LD          = ftn
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY -Ucray -UCRAY -U_CRAY -U_CRAYIEEE
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  =    
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS   = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxd1
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxd1	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxd1	(revision 4775)
@@ -0,0 +1,72 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN : MPI1/MPI2
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/crayxd1
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+# NETCDF library
+NETCDF_INCLUDE  = /opt/product/netcdf/netcdf-3.6.0-p1-pgi6/include 
+NETCDF_LIBRARY  = -L/opt/product/netcdf/netcdf-3.6.0-p1-pgi6/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+#F90         = ftn
+F90         = mpif90 -r8 -byteswapio -O0 -I$(INCLUDE_PATH)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc
+LD          = ftn
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS   = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)	
+#
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxt
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxt	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.crayxt	(revision 4775)
@@ -0,0 +1,75 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN : MPI1/MPI2
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = /lus/nid00030/cht/EC-Earth_2.2/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/crayxt
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+# NETCDF library
+NETCDFDIR=$(CRAY_NETCDF_DIR)/netcdf-cce-real64
+NETCDF_INCLUDE  = $(NETCDFDIR)/include
+NETCDF_LIBRARY  = -L$(NETCDFDIR)/lib -lnetcdf
+#
+#
+# Compiling and other commands
+MAKE        = make
+F90         = ftn 
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = cc
+LD          = ftn
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# For compiling in double precision, put -r8
+# For compiling in single precision, remove -r8 and add -Duse_realtype_single
+# 
+F90FLAGS_1  = -sreal64 -h byteswapio -O3 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS   = -sreal64 -h byteswapio -O3
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)	
+#
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.g95.openmpi
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.g95.openmpi	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.g95.openmpi	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# G95 and OPENMPI
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3 main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/oasis3-mct/bin
+#
+# MPI library
+MPIDIR      = /opt/openmpi-1.3.2-g95/
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpi_f90 -lmpi_f77 -lmpi
+#
+# NETCDF library
+NETCDF_INCLUDE1  = /opt/netcdf-4.0.1-g95-64-medium/include 
+# NETCDF_INCLUDE2  = 
+NETCDF_LIBRARY  = -L/opt/netcdf-4.0.1-g95-64-medium/lib -lnetcdf -L/opt/hdf5-1.8.3-g95-64/lib -lhdf5_hl -lhdf5 -lz -lm -lhdf5_hl -lhdf5 -lz
+#
+# Compiling and other commands
+MAKE        = make
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# 
+F90FLAGS_1  = -g -fbounds-check
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     =
+#
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE1)
+f90FLAGS  = $(f90FLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE1)
+FFLAGS    = $(FFLAGS_1) $(CPPDEF) $(INCPSMILE)  -I$(NETCDF_INCLUDE1)
+fFLAGS    = $(fFLAGS_1) $(CPPDEF) $(INCPSMILE)  -I$(NETCDF_INCLUDE1)
+CCFLAGS   = $(CCFLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE1)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_neptune
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_neptune	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_neptune	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3-MCT Makefile for a Linux system using 
+# GFORTRAN COMPILER and IMPI
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/NEPTUNE
+#
+# MPI library
+MPIDIR           = /softs/intel/ics-2012.0.032/impi/4.0.3.008/intel64
+MPIBIN           = $(MPIDIR)/bin
+MPI_INCLUDE      = $(MPIDIR)/include/gfortran/4.4.0
+MPILIB           = -L$(MPIDIR)/lib
+#
+# NETCDF library
+NETCDF_INCLUDE1 = /usr/include 
+NETCDF_INCLUDE2 = /usr/lib64/gfortran/modules
+NETCDF_LIBRARY  = -L/usr/lib64 -lnetcdff -lnetcdf  
+#
+# Compiling and other commands
+MAKE        = /usr/bin/make
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = $(MPIBIN)/mpigcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -g -ffree-line-length-0 -fbounds-check
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS           = $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE1) -I$(NETCDF_INCLUDE2)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE1) -I$(NETCDF_INCLUDE2)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE1) -I$(NETCDF_INCLUDE2)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE1) -I$(NETCDF_INCLUDE2)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE) -I$(GFORTRAN_INC_MOD)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_openmpi_cerfacs
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_openmpi_cerfacs	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.gfortran_openmpi_cerfacs	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3 main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/compile_oa3-mct_gfopenmpi
+#
+# MPI library
+MPIDIR      = /usr/lib64/openmpi
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = /usr/include/openmpi-x86_64
+MPILIB      = -L$(MPIDIR)/lib -lmpi_f90 -lmpi_f77 -lmpi
+#
+# NETCDF library
+NETCDF_INCLUDE1  = /usr/include 
+NETCDF_INCLUDE2  = /usr/lib64/gfortran/modules
+NETCDF_LIBRARY  = -L/usr/lib64 -lnetcdf -lnetcdff -L/usr/local/HDF5-1.8.6/lib -lhdf5_hl -lhdf5 -lz -lm -lhdf5_hl -lhdf5 -lz -lcurl
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+#  
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# 
+F90FLAGS_1  = -g -ffree-line-length-0 -fbounds-check
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     =
+#
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE2) -I$(NETCDF_INCLUDE1)
+f90FLAGS  = $(f90FLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE2) -I$(NETCDF_INCLUDE1)
+FFLAGS    = $(FFLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE2) -I$(NETCDF_INCLUDE1)
+fFLAGS    = $(fFLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE2) -I$(NETCDF_INCLUDE1)
+CCFLAGS   = $(CCFLAGS_1) $(CPPDEF) $(INCPSMILE) -I$(NETCDF_INCLUDE2) -I$(NETCDF_INCLUDE1)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ibmPw6_idris
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ibmPw6_idris	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ibmPw6_idris	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile adapted to  ECMWF's IBM power4 system.
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/AIX6
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+#  NETCDF library
+NETCDF_INCLUDE  = /usr/local/pub/NetCDF/3.6.2/include
+NETCDF_LIBRARY  = -L/usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = mpxlf90_r
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = mpcc_r
+LD          = $(F90)
+AR        = ar
+ARFLAGS   = r
+#
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -WF,-Duse_netCDF -WF,-Duse_comm_$(CHAN) -WF,-D__VERBOSE -WF,-DTREAT_OVERLAY
+CCPPDEF   = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+COMFLAGS  = -q64 -qextname=flush -O3 
+F90FLAGS_1  = -qsuffix=cpp=F90 $(COMFLAGS) 
+f90FLAGS_1  = -qsuffix=cpp=f90 $(COMFLAGS)
+FFLAGS_1    = -qfixed -qsuffix=cpp=F $(COMFLAGS) 
+fFLAGS_1    = -qfixed -qsuffix=cpp=f $(COMFLAGS)
+CCFLAGS_1   = -q64 
+#
+LDFLAGS   = -q64 -bmaxdata:2000000000 -O3
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) $(CCPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.inc
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.inc	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.inc	(revision 4775)
@@ -0,0 +1,15 @@
+#
+# System dependent settings 
+#
+# $Id: make.inc 1123 2006-09-06 12:14:56Z valcke $
+#
+##### User configurable options #####
+#
+# Note: The absolute path name must be indicated.
+#
+# Note: Choose one of these includes files and modify it according to your
+#       local settings. Replace the currently active file with your own.
+#
+include  $(HOME)/oasis3-mct/util/make_dir/make.intel_corail
+#
+### End User configurable options ###
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel.openmpi_cerfacs
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel.openmpi_cerfacs	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel.openmpi_cerfacs	(revision 4775)
@@ -0,0 +1,69 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/compile_oa3-mct_intelopenmpi
+#
+# MPI library
+MPIDIR      = /usr/local_intel12/openmpi143
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib 
+#
+# NETCDF library
+NETCDF_INCLUDE  = /usr/local_intel12/include
+NETCDF_LIBRARY  = -L/usr/local_intel12/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# 
+F90FLAGS_1  = -g -check all -CB -traceback -fno-alias -ip -align -msse3 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/pio  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel_corail
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel_corail	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.intel_corail	(revision 4775)
@@ -0,0 +1,73 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/CORAIL
+#
+# MPI library
+MPIDIR      = /opt/intel/impi/4.1.2.040/intel64
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib
+#
+# NETCDF library
+NETCDF_INCLUDE  = /usr/local/include
+NETCDF_LIBRARY  = -L/usr/local/lib -lnetcdf 
+#
+# Compiling and other commands
+MAKE        = /usr/bin/make
+F90         = $(MPIBIN)/mpiifort -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = $(MPIBIN)/mpiicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpiifort $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+#F90FLAGS_1  = -g -check all -CB -traceback -vec-report0 -O0 -fno-alias -ip -align -msse3
+#F90FLAGS_1  = -vec-report0 -O0 -g -traceback -fp-model source -dno-alias -align
+F90FLAGS_1  = -vec-report0 -O0 -fno-alias -ip -align -msse3
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+#CCFLAGS_1   = -vec-report0 -O0 -g -traceback -fno-alias -align -fp-model precise
+CCFLAGS_1   = -vec-report0 -O0 -fno-alias -ip -align -msse3
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.jade
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.jade	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.jade	(revision 4775)
@@ -0,0 +1,73 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/compile_oa3-mct
+#
+# MPI library
+MPIDIR      = /opt/software/SGI/SGI/MPT/2.02
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+#MPILIB      = -L$(MPIDIR)/lib
+MPILIB      = -lmpi 
+#
+# NETCDF library
+NETCDF_INCLUDE  = /opt/software/SGI/netcdf/4.0/include
+NETCDF_LIBRARY  = -L /opt/software/SGI/netcdf/4.0/lib -lnetcdff -lnetcdf 
+#
+# Compiling and other commands
+MAKE        = gmake
+#F90         = mpif90
+F90         = ifort
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = icc
+LD          = ifort
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# 
+F90FLAGS_1  = -O2 -I. -assume byterecl
+#F90FLAGS_1  =  -g -check all -CB -assume byterecl  -I. 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS   = $(F90FLAGS_1) 
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+#FLIBS		= $(NETCDF_LIBRARY)
+FLIBS		= $(NETCDF_LIBRARY) $(LCPP) $(LIBXML)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/mct -I$(LIBBUILD)/scrip
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.lfc_admin1
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.lfc_admin1	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.lfc_admin1	(revision 4775)
@@ -0,0 +1,70 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Lahey Fortran Compiler and MPICH1
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/Linux
+#
+# MPI library
+MPIDIR      = /raid1/tsilva/local/mpich-1.2.7p1
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpichf90 -lmpich
+#
+# NETCDF library
+NETCDF_INCLUDE  = /raid1/tsilva/local/netcdf/include
+NETCDF_LIBRARY  = -L/raid1/tsilva/local/netcdf/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -g -byteswapio  
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS   = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.mn3
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.mn3	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.mn3	(revision 4775)
@@ -0,0 +1,73 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2/NONE)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/MN3
+#
+# MPI library
+MPIDIR      = /gpfs/apps/MN3/INTEL/impi/4.1.3.049/intel64
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpi -lmpigf -lmpigi
+#
+# NETCDF library
+NETCDF_DIR      = /apps/NETCDF/4.1.3
+NETCDF_INCLUDE  = ${NETCDF_DIR}/include
+NETCDF_LIBRARY  = -L${NETCDF_DIR}/lib64 -lnetcdff -lnetcdf 
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpiifort -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = mpiicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpiifort $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+#CPPDEF    = -Duse_libMPI -Duse_netCDF -Duse_comm_$(CHAN) -DDEBUG -D__VERBOSE -DTMG_PERF
+CPPDEF    = -Duse_libMPI -Duse_netCDF -Duse_comm_$(CHAN) -DTMG_PERF 
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+#F90FLAGS_1  = -g -O2 -I.
+F90FLAGS_1  = -O2 -I.
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = -O2
+LDFLAGS     = -L/apps/HDF5/1.8.10/lib/ -lhdf5 -lhdf5_hl -L/apps/SZIP/2.1/lib/ -lsz
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/mct -I$(LIBBUILD)/scrip
+#
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.octopus_lam
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.octopus_lam	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.octopus_lam	(revision 4775)
@@ -0,0 +1,72 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/OCTOPUS
+#
+# MPI library
+MPIDIR      = /gpfs3/SOFTS/local_pgi/lam7.0.6
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpi
+#
+# NETCDF library
+NETCDF_INCLUDE  = /gpfs3/SOFTS/local_pgi/include
+NETCDF_LIBRARY  = -L/gpfs3/SOFTS/local_pgi/lib -lnetcdf
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif77 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = $(MPIBIN)/mpicc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif77 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# checking bounds and debug -g -C
+# 
+F90FLAGS_1  = -g -C -Mbounds -byteswapio  
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS   = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)	
+#
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.pgi_cerfacs
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.pgi_cerfacs	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.pgi_cerfacs	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = /space/$(USER)/oasis3-mct_comp
+#
+# MPI library
+#For machines in training room, put MPIDIR      = /usr/local/pgi/linux86-64/2011/mpi/mpich/
+MPIDIR      = /usr/local/pgi/linux86-64/2011/mpi/mpich/
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpichf90 -lmpich
+#
+# NETCDF library
+NETCDF_INCLUDE  = /usr/local/include
+NETCDF_LIBRARY  = -L/usr/local/lib -lnetcdff -lnetcdf -L/usr/local/HDF5-1.8.6/lib -lhdf5_hl -lhdf5 -lz -lm -lhdf5_hl -lhdf5 -lz -lcurl
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = pgcc -I$(MPI_INCLUDE) -pgf90libs
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -C -g -Mbounds -byteswapio 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx8_meteo
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx8_meteo	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx8_meteo	(revision 4775)
@@ -0,0 +1,80 @@
+#
+# Include file for OASIS4 Makefile for a Linux system using Portland Group Fortran Compiler
+# and MPICH
+#
+#######################################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/SX8
+#
+MAKE        = gmake
+MPIDIR      = /SX/opt/mpisx/inst
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib0
+#
+NETCDF_INCLUDE  = /usr/local/lib/NETCDF-3.6.1/include
+NETCDF_LIBRARY  = -L/usr/local/lib/NETCDF-3.6.1/lib -lnetcdf
+#
+LCPP = /SX/usr/lib/libcpp.a
+#
+# Compiling and other commands
+#
+F90         = $(MPIBIN)/sxmpif90 -f4 -I$(MPI_INCLUDE)
+F           = $(MPIBIN)/sxmpif90 -f0 -I$(MPI_INCLUDE)
+f90         = $(F90)
+f           = $(F)
+CC          =  $(MPIBIN)/sxmpicc  -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/sxmpif90 $(MPILIB)
+#
+AR        = sxar
+ARFLAGS   = -ruv
+#
+#
+# compiler options and cpp keys
+#
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+CCPPDEF   = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+#
+#COMFLAGS  =  -clear -Cvsafe  -Wf"-init stack=nan heap=nan -K a" -EP 
+#COMFLAGS  =  -clear -Cdebug -g -pi auto nest=3 line=100000 -EP 
+COMFLAGS  =  -clear -Cvopt 
+
+F90FLAGS_1  = $(COMFLAGS) -EP -Wf,-pvctl noassume loopcnt=30000 -dwW -Wf,-P nh 
+f90FLAGS_1  = $(F90FLAGS_1) 
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = $(COMFLAGS) 
+
+LDFLAGS   = -Pstack
+#
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY) $(LCPP)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) $(CCPPDEF) -I$(NETCDF_INCLUDE)
+#
+#
+#############################################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx_frontend
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx_frontend	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.sx_frontend	(revision 4775)
@@ -0,0 +1,73 @@
+#
+# Include file for OASIS3 Makefile adapted to NEC SX-6 at DKRZ
+#
+##############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/SX
+#
+# MPI library
+MPIDIR      = /SX/opt/mpisx/inst
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib -lmpichf90 -lmpich
+#
+# NETCDF library
+NETCDF_INCLUDE  = /pool/SX-6/netcdf/netcdf-3.5.0/include
+NETCDF_LIBRARY  = -L/pool/SX-6/netcdf/netcdf-3.5.0/lib -lnetcdf
+#
+LCPP        = /SX/usr/lib/libcpp.a
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/sxmpif90 -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = $(MPIBIN)/sxmpic++ -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/sxmpif90
+#
+AR          = sxar
+ARFLAGS     = -r
+#
+#
+# compiler options and cpp keys
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+#
+F90FLAGS_1  = -EP -Pstack  -Wf,-pvctl noassume loopcnt=5000000  -Wl,-h lib_cyclic  -Wf,-L fmtlist transform $(PSMILE_INCDIR) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   =    
+LDFLAGS     = 
+#
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY) $(LCPP) 
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/scrip  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+###############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ubuntu
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ubuntu	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make.ubuntu	(revision 4775)
@@ -0,0 +1,69 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2/NONE)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = $(HOME)/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/../compile_oa3-mct
+#
+# MPI library
+MPIDIR      = /usr
+MPIBIN      = $(MPIDIR)/bin
+MPI_INCLUDE = $(MPIDIR)/include
+MPILIB      = -L$(MPIDIR)/lib 
+#
+# NETCDF library
+NETCDF_INCLUDE  = /usr/include
+NETCDF_LIBRARY  = -L/usr/lib -lnetcdff
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = $(MPIBIN)/mpif90 -Wall -I$(MPI_INCLUDE)
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = gcc -I$(MPI_INCLUDE)
+LD          = $(MPIBIN)/mpif90 $(MPILIB)
+AR          = ar
+ARFLAGS     = -ruv
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_netCDF -Duse_comm_$(CHAN) -D__VERBOSE -DTREAT_OVERLAY
+#
+# 
+F90FLAGS_1  = 
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = 
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/pio  -I$(LIBBUILD)/mct 
+
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make_X64_ADA
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make_X64_ADA	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/make_dir/make_X64_ADA	(revision 4775)
@@ -0,0 +1,71 @@
+#
+# Include file for OASIS3 Makefile for a Linux system using 
+# Portland Group Fortran Compiler and MPICH
+#
+###############################################################################
+#
+# CHAN	: communication technique used in OASIS3 (MPI1/MPI2/NONE)
+CHAN            = MPI1
+#
+# Paths for libraries, object files and binaries
+#
+# COUPLE	: path for oasis3-mct main directory
+COUPLE          = /workgpfs/rech/ces/rces980/modBRETAGNE/oasis3-mct
+#
+# ARCHDIR       : directory created when compiling
+ARCHDIR         = $(COUPLE)/BLD
+#
+# MPI library
+MPIDIR      = 
+MPIBIN      = 
+MPI_INCLUDE = 
+MPILIB      = 
+#
+# NETCDF library
+NETCDF_INCLUDE  = /smplocal/pub/NetCDF/4.1.3/include
+NETCDF_LIBRARY  = -L/smplocal/pub/NetCDF/4.1.3/lib -Bstatic -lnetcdff -lnetcdf -lnetcdf_c++ -L/smplocal/pub/HDF5/1.8.9/seq/lib -Bstatic -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -Bdynamic -lz
+#
+# Compiling and other commands
+MAKE        = gmake
+F90         = mpiifort
+F           = $(F90)
+f90         = $(F90)
+f           = $(F90)
+CC          = cc
+LD          = mpiifort
+AR          = ar
+ARFLAGS     = r
+#
+# CPP keys and compiler options
+# 
+CPPDEF    = -Duse_libMPI -Duse_netCDF -Duse_comm_$(CHAN) -DTMG_PERF
+#
+# -g is necessary in F90FLAGS and LDFLAGS for pgf90 versions lower than 6.1
+# 
+F90FLAGS_1  = -O2 -I.
+#F90FLAGS_1  = -O3 -xAVX -I. -fp-model precise
+f90FLAGS_1  = $(F90FLAGS_1)
+FFLAGS_1    = $(F90FLAGS_1)
+fFLAGS_1    = $(F90FLAGS_1)
+CCFLAGS_1   = -O2 -xAVX
+LDFLAGS     = 
+#
+###################
+#
+# Additional definitions that should not be changed
+#
+FLIBS		= $(NETCDF_LIBRARY)
+# BINDIR        : directory for executables
+BINDIR          = $(ARCHDIR)/bin
+# LIBBUILD      : contains a directory for each library
+LIBBUILD        = $(ARCHDIR)/build/lib
+# INCPSMILE     : includes all *o and *mod for each library
+INCPSMILE       = -I$(LIBBUILD)/psmile.$(CHAN) -I$(LIBBUILD)/mct -I$(LIBBUILD)/scrip
+#
+F90FLAGS  = $(F90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+f90FLAGS  = $(f90FLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+FFLAGS    = $(FFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+fFLAGS    = $(fFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+CCFLAGS   = $(CCFLAGS_1) $(INCPSMILE) $(CPPDEF) -I$(NETCDF_INCLUDE)
+#
+#############################################################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/README
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/README	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/README	(revision 4775)
@@ -0,0 +1,81 @@
+============================================================================================
+The OASISGUI is an application of the software OPENTEA developped at CERFACS in the CFD group
+by Antoine Dauptain.
+Below are the instructions to run oasisgui to create the configuration file namcouple of 
+OASIS3-MCT on a Linux computer.
+============================================================================================
+In the directory oasisgui you have different directories:
+- examples_xml_namcouple : two examples of xml files and their corresponding namcouple files
+- opentea: sources of the software
+- library: applications developped using OPENTEA (typically OASIS3-MCT application)
+- XDRpy: main generic python tools for OPENTEA interface
+and you have different files:
+- gittag: reference under git repository
+- myconfig.xml: my configuration file
+- README: explanations
+
+
+####
+If you use a MAC to log on the X11 terminal where the GUI will be executed, you must
+modify the X11/OSX Focus correction putting <focusCorrection value="1"/> in
+your configuration "myconfig.xml" file.
+You can also use the menu "Config" directly in the software to modify the file
+"myconfig.xml" but the new parameters will be activated only after closing and re-launching the GUI.
+
+####
+Before launching opentea, you must make sure that wish (based on tcl/tk version 8.5 or later) and 
+Python (version 2.6 or later) are installed on your platform and that they are configured to run opentea.
+- to have the version of Python : >python -V
+- to have the version of tcl/tk : >echo "puts [info tclversion]" | tclsh 
+
+Your PYTHONPATH must include the $dir/oasis3-mct/util/oasisgui/XDRpy directory 
+("dir" is the repository where is located oasis3-mct on your computer):
+In your .cshrc you must add :
+----------------------------------------------------------
+setenv OASISGUIHOME $dir/oasis3-mct/util/oasisgui
+if ($?PYTHONPATH) then
+   setenv PYTHONPATH $OASISGUIHOME/XDRpy:$PYTHONPATH
+else
+   setenv PYTHONPATH $OASISGUIHOME/XDRpy
+endif
+----------------------------------------------------------
+In your .bashrc you must add :
+----------------------------------------------------------
+export OASISGUIHOME=$dir/oasis3-mct/util/oasisgui
+if [ "x${PYTHONPATH}" == "x" ]
+then
+export PYTHONPATH=$OASISGUIHOME/XDRpy
+else
+export PYTHONPATH=$OASISGUIHOME/XDRpy:$PYTHONPATH
+fi
+----------------------------------------------------------
+
+
+####
+To be able to launch easily opentea using the command wish, you should also create the 
+alias "oasisgui" to launch the software:
+---------------------------------------------
+in ksh :
+alias oasisgui 'wish $OASISGUIHOME/opentea/opentea.tcl -config $OASISGUIHOME/myconfig.xml -code oasis3-mct &'
+---------------------------------------------
+in bash :
+alias oasisgui='wish $OASISGUIHOME/opentea/opentea.tcl -config $OASISGUIHOME/myconfig.xml -code oasis3-mct &'
+---------------------------------------------
+
+
+#####
+Once you have launch oasisgui, you must fill up the different tabs from the left
+to the right. Each window must be validated (button "process" on the bottom on the 
+right in the window). 
+An orange bullet in the tab means that no information was stored yet in the window, 
+a red bullet in the tab means that there is an error in the window and a green bullet 
+in the tab means that the data entered in the window has been processed and is correct. 
+Some documentation about the meaning of the variables is available in the different windows,
+ by clicking on the different blue bullets ("Learn more").
+Validated data are progressively stored in an xml file when filling the GUI. This file 
+must be explicitely saved when leaving the GUI (you will be automatically asked for this).
+Once you saved your xml data, you can reload your xml file using the (File/Load as new) menu at 
+the left top of the GUI. Do not use the (File/Load as part) menu.
+The configuration file namcouple of OASIS3-MCT will be saved, when ALL THE TABS will 
+be validated, in the repository where you saved your xml file, in a subdirectory named
+after your xml file.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/.gitignore
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/.gitignore	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/.gitignore	(revision 4775)
@@ -0,0 +1,2 @@
+/*.pyc
+/.gitignore
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/SAV.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/SAV.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/SAV.py	(revision 4775)
@@ -0,0 +1,127 @@
+import os, stat, sys
+import hashlib
+
+
+
+class FileDB:
+
+    fields = ["name","path","signature","md5"]
+    md5 = True
+
+
+
+    def __init__(self,obj):
+        """
+        Instanciation de la base de donnees a partir d'un repertoire ou d'un fichier de sauvegarde
+        """
+        if os.path.isdir(obj):
+            self._mapDirectory(obj)
+        elif os.path.isfile(obj):
+            self._loadFromFile(obj)
+        else :
+            raise Exception(str(obj)+" is not a valid address")
+
+    def __repr__(self):
+        return "A file database instance"
+
+    def __str__(self):
+        """
+        Affichage du contenu de l'instance
+        """
+        res = []
+        for l in self._db:
+            res.append(os.path.join(l["path"],l["name"])+" ==> "+l["signature"])
+
+        return "\n".join(res)
+
+
+    def _loadFromString(self,str):
+        """
+        Chargement ou rechargement du contenu de la base de donnee a partir d'une chaine de caractere au format CSV
+        """
+        self._db = [dict(zip(FileDB.fields,f.split(";"))) for f in str.split("\n")]        
+
+    def _loadFromFile(self,file):
+        """
+        Chargement ou rechargement du contenu de la base de donnee a partir d'un fichier CSV
+        """
+        content = open(file,"r").read()
+        self._loadFromString(content)
+
+    def _mapDirectory(self,dir):
+        """
+        Parcours le repertoire dir et stocke son arborescence dans la memoire interne de l'instance
+        La recusion est faite dans le os.walk
+        """
+        self._db = []
+        for root, dirs, files in os.walk(dir):
+            for name in files:
+                fileNode = {}
+                fileNode["name"] = name
+                fileNode["path"] = os.path.abspath(root)
+                fileNode["signature"] = str(FileDB._signature(os.path.join(root,name)))
+                if FileDB.md5:
+                    fileNode["md5"] = FileDB.md5file(os.path.join(os.path.abspath(root),name))
+                else:
+                    fileNode["md5"] = ""
+                self._db.append(fileNode)
+
+    def save(self,file):
+        """
+        Ecrit le contenu de la BDD au format CSV
+        """
+        content=[]
+        for line in self._db:
+            tempLine=[]
+            for field in FileDB.fields:
+                tempLine.append(line[field])
+            content.append(";".join(tempLine))
+
+        out = open(file,"w")
+        out.write("\n".join(content))
+
+    def isInDb(self,file):
+        """
+        Recherche si un fichier est present dans la base de donnees (nom et signature sont compares)
+        Retourne la liste des fichiers correspondant, liste vide si aucun element
+        """
+        if not(os.path.isfile(file)):
+            raise Exception(file + " not found")
+
+        dirName, fileName = os.path.split(file)
+        sig = FileDB._signature(file)
+        results = [elm for elm in self._db if elm["name"] == fileName and elm["signature"]==str(sig)]
+        
+        if FileDB.md5:
+            md5 = FileDB.md5file(file)
+            results = [elm for elm in self._db if elm["name"] == fileName and elm["md5"]==str(md5)]
+            
+        return [os.path.join(elm["path"],elm["name"]) for elm in results]
+        
+
+    @staticmethod
+    def _signature(file):
+        """
+        Cree une signature du fichier (mode, taille en octet, date de modification)
+        """
+        st = os.stat(file)
+        return (stat.S_IFMT(st.st_mode),
+                st.st_size,
+                st.st_mtime)
+    
+    # commente car pb avec python 2.4 et 2.5
+    # chunksize depend de la machine il faudra optimiser
+    
+    @staticmethod
+    def md5file(fileName,chunksize=13):
+        md5 = hashlib.md5()
+        f = open(fileName,'rb') 
+        for chunk in iter(lambda: f.read(2**chunksize), b''): 
+            md5.update(chunk)
+        f.close()
+        return md5.hexdigest()
+
+
+if __name__ == "__main__":
+    db = FileDB('.')
+    db.save('XDR-FileDB.csv')
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/XDR.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/XDR.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/XDR.py	(revision 4775)
@@ -0,0 +1,1596 @@
+#!/usr/bin/env python
+# -*- coding: utf-8 -*-
+ # __   _______  _____              
+ # \ \ / /  __ \|  __ \             
+ #  \ V /| |  | | |__) |_ __  _   _ 
+ #   > < | |  | |  _  /| '_ \| | | |
+ #  / . \| |__| | | \ \| |_) | |_| |
+ # /_/ \_\_____/|_|  \_\ .__/ \__, |
+ #                     | |     __/ |
+ #                     |_|    |___/ 
+
+"""
+
+XDR.py
+------
+
+Created  by A. Dauptain and G Frichet
+
+Main generic tools for C3Sm interface
+Requires version 2.6.6 or later of python 2
+Does not run with python 3
+
+
+
+"""
+import sys
+if ((sys.hexversion < 0x020606F0) or
+    (sys.hexversion > 0x030000A0)):
+    raise Exception(
+            "Must be run with python version at least 2.6.6, and not python 3\n"
+            "Your version is %i.%i.%i" % sys.version_info[:3])
+
+from xml.dom.minidom import *
+import xml.parsers.expat
+import time, os, subprocess, re, string,shutil
+import filecmp
+import fileinput
+import imp
+import codecs
+from itertools import izip
+import shlex
+
+import glob
+
+
+# Warnig cannot be importedblike this :
+#if we use xdrpy on distant locations, SAV will be missing
+#import SAV
+
+
+
+
+"""
+This library intends to provide methods to access and modify XML datasets read and written
+by C3Sm.
+Moreover, this library provides methods to deal with ascii files that might be read and written by external programs.
+
+There are two parts in this library :
+The first one is composed of high-level procedures.
+The second one is a set of classes used by the high-level procedures.
+Normal developers does not have to use them, even if they can !"""
+
+ # _    _ _       _       _                _ 
+ #| |  | (_)     | |     | |              | |
+ #| |__| |_  __ _| |__   | | _____   _____| |
+ #|  __  | |/ _` | '_ \  | |/ _ \ \ / / _ \ |
+ #| |  | | | (_| | | | | | |  __/\ V /  __/ |
+ #|_|  |_|_|\__, |_| |_| |_|\___| \_/ \___|_|
+ #           __/ |                           
+ #          |___/                            
+
+def init():
+    """
+    This procedure initializes the XDR environment.
+    It must be called at the beginning of every script using XDR.
+    
+    ==== Dev =====
+    This procedures creates an interface "dsin" for reading XML file "dataset.xml" produced by C3Sm
+    It creates also a copy of this dataset "dsout", modifiable, to be read by C3Sm, "out_dataset.xml"
+    It also stores useful paths (current directory at launch of the script (not to lose C3Sm) and script directory)
+    """   
+    
+    global dsin
+    global dsout
+    global startingDir
+    global scriptDir
+    global verbose
+    global OrigAppName
+    global projectName
+    
+    global timestamp
+    global COMMON_DIRECTORY,PREFIX,DIGIT_NUMBER
+
+    
+    verbose = 0
+    startingDir=os.getcwd()
+    scriptDir=os.path.dirname(os.path.abspath(sys.modules['__main__'].__file__))
+
+    dsin=Dataset("dataset.xml")
+    dsout=Dataset("dataset.xml")
+    os.remove("dataset.xml")
+    
+    OrigAppName = dsout.getValue("name","solver","meta")
+    projectName = dsout.getValue("name","project","meta")
+    
+    
+    
+    print "Local  use of XDRpy for project ",projectName, "(",OrigAppName,")"
+    
+    
+    print  dsout.getValue("pluginsPath","engine","meta")
+    #
+    
+    PREFIX = "RUN_"
+    DIGIT_NUMBER = 3
+    COMMON_DIRECTORY = "COMMON"
+    
+    if OrigAppName == "none" :
+        print "Warning : XDRpy unable to find the origin application"
+    else :
+        print "XDRpy running for application : ",OrigAppName
+        COMMON_DIRECTORY = os.path.join(COMMON_DIRECTORY,OrigAppName.upper())
+    
+    
+    
+    
+    timestamp = time.time()
+    
+    return dsin,dsout
+
+def finish(a=0):
+    """
+    This procedure closes the XDR environment.
+    It must be called at the end of every script using XDR.
+    
+    ==== Dev ====
+    This procedure saves the output XML file and changes the directory to the initial one
+    """
+
+    oldDir = os.getcwd()
+    os.chdir(startingDir)
+    if a != 0 :
+        a.save2file("out_dataset.xml")
+    else :
+        try:
+            dsout.save2file("out_dataset.xml")
+            
+        except NameError:
+            pass
+
+def progress(percent,message):
+    """ This function lets c3sm know progresse of the current script
+    percent is the percentage of work done (0 < percent < 100)
+    message is a little status written by the progressbar, it shouldn't be too long
+    """
+    global timestamp
+    
+    time.sleep(0.1)
+    newtime = time.time()
+
+    print "%"+str(int(percent))+"%"+str(message)
+    print '{0:2f}'.format(newtime-timestamp-0.1)+"s \n"+ str(int(percent))+"% "+str(message) 
+    sys.stdout.flush()
+    timestamp=newtime
+    
+    
+def getDsin():
+    """ This procedure returns the Dataset object representing the input xml file """
+    try:
+        return dsin
+    except NameError:
+        error("XDRError : XDR library must be initialized")
+        
+        
+def getDsout():
+    """ This procedure returns the Dataset object representing the current dataset """
+    try:
+        return dsout
+    except NameError:
+        error("XDRError : XDR library must be initialized")
+    
+
+def tryGetValue(default, key, *path):
+    """
+    Search for the node "nodeName" with elements of "path" in its path and return its value
+    If node doesn't exist, catch XDRnoNodeException end return the default value
+    
+    It would be cleaner to use "path" as a list, instead of "*path", but this would change all the geValue calls :(
+        To be evaluated later
+    """
+    return dsout.tryGetValue(default, key, *path)
+
+
+def getValue(key,*path):
+    """
+    This procedure returns the value of a specified tag in the dataset.
+    If more than one node have the same name, one or more parts of the path have to be specified.
+    Ex :
+    getValue("myParam")
+    or
+    getValue("myParam","parent","parent of parent")
+    
+    It would be cleaner to use "path" as a list, instead of "*path", but this would change all the geValue calls :(
+        To be evaluated later
+    """
+    return dsout.getValue(key,*path)
+    
+
+def getListValue(key,*path):
+    """
+    This procedure gets the asked value from the dataset and returns it as a list
+    """
+    return dsout.getListValue(key,*path)
+
+
+def getIntegerValue(key,*path):
+    """
+    This procedure returns an integer corresponding to the value of a specified tag in the dataset. 
+    If more than one node have the same name, one or more parts of the path have to be specified.
+    """
+    return int(dsout.getValue(key,*path))
+
+
+def getFloatValue(key,*path):
+    """
+    This procedure returns a float corresponding to the value of a specified tag in the dataset. 
+    If more than one node have the same name, one or more parts of the path have to be specified.
+    """
+    return float(dsout.getValue(key,*path))
+
+
+def getChildrenName(nodeName,*path):
+    """
+    This procedure returns a list of the name of all the children of the node named "nodeName".
+    If more than one node has the same name, parts of its path can be specified as for the getValue method
+    """
+    return dsout.getChildrenName(nodeName,*path)
+
+
+def setValue(value,nodeName,*path):
+    """
+    This procedure modifies the node specify and set its value to "value"
+    If more than one node has the same name, parts of its path can be specified as for the getValue method
+    """
+    dsout.setValue(value,nodeName,*path)
+    
+
+def nodeExists(nodeName,*path):
+    """
+    This procedure checks if the node exists or not. It returns 1 if it exists, 0 if not
+    """
+    return dsout.nodeExists(nodeName,*path)
+    
+
+
+ #
+ # ______                     _       
+ #|  ____|                   | |      
+ #| |__  __  _____  ___ _   _| |_ ___ 
+ #|  __| \ \/ / _ \/ __| | | | __/ _ \
+ #| |____ >  <  __/ (__| |_| | ||  __/
+ #|______/_/\_\___|\___|\__,_|\__\___|
+ #                                    
+                                     
+def execute(command, always_print_err=False, silent=True):
+    """
+    This procedure searches for the specified executable in the script directory, if not, it tries to execute the command itself.
+    The command is then executed and its output is printed in standard output
+    """
+    ####### Need some work to handle long run and reading of the output on the fly !
+    if (os.path.exists(os.path.join(scriptDir,command))):
+        command=os.path.join(scriptDir,command)
+    print "command "+ command
+    command=shlex.split(command)
+    if silent == False :
+        print "Executing " + repr(command) + ' in ' + repr(os.getcwd()) + ':\n' + 50*'-' + '\n'
+    read_from = None
+    if "<" in command :
+        read_from = command[-1]
+        command = command[:-2]
+    p=subprocess.Popen(command,stdin=subprocess.PIPE, stdout=subprocess.PIPE, stderr=subprocess.PIPE)
+    if read_from:
+        p.stdin.write(open(read_from, "r").read())
+
+    stdout_data = []
+    if silent == False :
+        print "\nXDRExecute =============StdOut=================\n"
+    while True:
+        line = p.stdout.readline()
+        if not line:
+            break
+        if silent == False :
+            print 'XDRExecute ' + line.rstrip()
+        sys.stdout.flush()
+        stdout_data.append(line)
+    returncode = p.wait()
+    stderr_data = p.stderr.read()
+    
+    if ( always_print_err and not returncode ):
+        if silent == False :
+            print "\nXDRExecute =============StdErr=================\n"
+            print 'XDRExecute ' + "\nXDRExecute ".join(stderr_data.split('\n'))
+    # if traite "None" "0" False" "" Comme des retours negatif
+    if returncode:
+        error("Problem while running command :"+" ".join(command)+"\n=============StdErr=================\n"+stderr_data)
+    return "".join(stdout_data)
+
+
+
+ #
+ #  _____     _     
+ # / ____|   | |    
+ #| (___  ___| |__  
+ # \___ \/ __| '_ \ 
+ # ____) \__ \ | | |
+ #|_____/|___/_| |_|
+ #                  
+                           
+def ssh_host(host, login):
+    """reconstruct full host description"""    
+    full_host = host
+    if host == None or host == "":
+        error("SSH host unspecified")
+    
+    if login != None and login != "":
+        full_host = login + '@' + host
+
+    return full_host
+
+def ssh(host, login, command, options=""):
+    """ Executes a command through SSH """
+    # TODO: check that we are on a platform were ssh actually exists
+    full_host = ssh_host(host, login)
+
+    output= execute("""ssh """ + options + """ """ + full_host + """ '"""+command+"""'""")
+    return output
+
+def ssh_prepare_directory(host, login, distant_directory):
+    """ Prepare (creates) a directory on a distant server """
+    # TODO: check that we are on a platform where ssh actually exists
+
+    if len(distant_directory) == 0:
+        error("Please specify a distant directory, for example : /home/toto/")
+
+    if distant_directory[0] != '/' and distant_directory[0] != '~':
+        error("Relative path given. Please specify an absolute path")
+
+    print "Making sure distant directory is ready..."
+    command = """mkdir -p """ + distant_directory
+    ssh(host, login, command)
+
+def ssh_send(host, login, distant_directory, local_directories_list, options=""):
+    """ Uploads files to a server using ssh.
+        This creates a tar archive, and pipes it through ssh to a 'tar xf' on the distant side.
+        In short, the command that we run is:
+        tar cf - directory1 directory2 | ssh distant_server "tar xf - -C distant_directory"
+        (with some additional safety)
+    """
+    # TODO: check that we are on a platform where tar, scp, ssh actually exist
+
+    # TODO: Check that local_directories_list is actually a list.
+    # People will try with string, and it does bad things with strings.
+
+    full_host = ssh_host(host, login)
+
+    if (len(local_directories_list) == 0):
+        print "No directories to be sent"
+        return
+
+
+    print "Sending and extracting archive..."
+    
+    # Decomposition
+    # Bash : passage en bash
+    # -c  :(...)
+    # tar cvf : compresse
+    # local directoryes_list (liste de tous les rep a envoyer)
+    # - : vers le pipe
+    # | : pipe
+    # ssh mylogin@host -
+    # \:(...)
+    # tarc xv : decompresse
+    # - depuis le pipe
+    # -C:(...)
+    # distant directory : Dans la directory distante
+    # \ :(...)
+    
+    command = """bash -c "tar cvf - """ + (" ".join(local_directories_list)) + """ | ssh """ + full_host + """ \\\"tar xf - -C """ + distant_directory + """\\\" " """
+    #print "ssh_send command ",command
+    execute(command,always_print_err=True)
+
+def ssh_retrieve(host, login, distant_directory, directory, options=""):
+    """ Transfers files from a server using ssh.
+        This is the opposite of ssh_send, except it operates on a single directory.
+    """
+    # TODO: check that we are on a platform where scp actually exists
+    full_host = ssh_host(host, login)
+    
+    
+    # M RIVIERE Solution -Deprecated-  ( Il y a pb non resolu dedans)
+    
+    # Decomposition
+    # Bash : passage en bash
+    # -c  : interprete la chaine de caractÃšres suivante
+    # ssh mylogin@host -
+    # \:(...)
+    # tar cvf : compresse
+    # - : vers le pipe
+    # -C:(...)
+    # distant directory
+    # local directory
+    # \ :(...)
+    # | : pipe
+    # tarc xvf : decompresse
+    # - depuis le pipe
+    #command = """bash -c "ssh """ + full_host + """ \' tar cvf - -C """ + distant_directory + """ """ + directory + """\\\" | tar xvf -" """
+   
+    # G DEJEAN Sokution
+    # Decomposition
+    # Bash : passage en bash
+    # -c  : interprete la chaine de caractÃšres suivante
+    # ssh mylogin@host
+    # '
+    # cd distant directory: 
+    # tar cvf : compresse
+    # - : vers le pipe
+    # . : le repretoire courant
+    # '
+    # | : pipe
+    # tar -x vf : decompresse
+    # -C local directory : en renommant le repertoire
+    # -vf :
+    # - :depuis le pipe
+    command = """bash -c " ssh """ + full_host + """ 'cd """+ distant_directory + """;  tar cvf - .'| tar -x -C """ +directory+""" -vf - " """
+   
+    print "ssh_retrieve command ",command
+    execute(command,always_print_err=True)
+
+
+def ssh_cleanup_directory(host, login, distant_directory, directory):
+    """ Remove a directory on distant ssh server """
+    print "Cleaning up distant files..."
+    command = """rm -rf """ + distant_directory + """/""" + directory
+    ssh(host, login, command)
+
+def tar(file, filelist):
+    """ Create an archive from a list of files """
+    # TODO: Windows support ? Use pkgfile.py or something ?
+    execute("tar cvf " + file + " " + " ".join(filelist))
+
+
+
+def error(txt):
+    """
+    This procedure stops the script and make sure to say it to C3Sm
+    """
+    try :
+        dsout.setValue("0","scriptSuccess","meta")
+    except NameError:
+        pass
+    print "Error : "+txt
+    finish()
+    exit()
+    
+
+def verbose():
+    """ This procedure activates verbosing for the library"""
+    global verbose
+    verbose = 1
+    print "Verbose activated ... ("+str(verbose)+") "
+    
+    
+def getScriptDir():
+    """ This accessor returns the value of the script directory for the current solver"""
+    global scriptDir
+    return scriptDir
+
+def getCommonDir():
+    """ This accessor returns the value of the script directory for the current solver"""
+    global COMMON_DIRECTORY
+    return COMMON_DIRECTORY
+
+
+ #   
+ # _____        _                 _   
+ #|  __ \      | |               | |  
+ #| |  | | __ _| |_ __ _ ___  ___| |_ 
+ #| |  | |/ _` | __/ _` / __|/ _ \ __|
+ #| |__| | (_| | || (_| \__ \  __/ |_ 
+ #|_____/ \__,_|\__\__,_|___/\___|\__|
+ #                                    
+                                     
+class Dataset:
+    """ This class defines a reader for XML files written by C3Sm.
+    Specifying a XML file, the XDR interface stores the dataset and 
+    implements several methods to access values and structures of the dataset"""
+    
+    def __init__(self,xmlfile):
+        """ XDR constructor : it needs a XML file from C3Sm """
+        self._xmlFile=xmlfile
+        try :
+            self._dom=parse(self._xmlFile)
+        except IOError:
+            error("XDRError : Problem with file system, check that permissions and free space are ok.\n"+xmlfile+" couldn't be read")
+        except xml.parsers.expat.ExpatError , err:
+            print err
+            XMLfile = open(self._xmlFile,"r").read().split("\n")
+            print "--> "+XMLfile[err.lineno+1]
+            print " "*(4+err.offset)+"^"
+            
+            
+            error("XDRError : Xml file from c3sm wasn't correct xml, please check that you have enough free space and you have the last version of C3Sm. Otherwise, please send dataset.xml from your project directory to C3Sm team")
+        self._root=self._dom.documentElement
+        self._currentNode=self._root
+        self._outputFile=""
+        
+    def __repr__(self):
+        return self._printNode() 
+    
+    def _printNode (self, sep=''):
+        """ This private method is a recursive method to describe the content of the dataset for debugging purpose"""
+        desc=""
+        node=self._currentNode
+        if node.nodeType == 1:
+            desc+= sep+node.nodeName+ ' >> '
+            for cle,valeur in node.attributes.items():
+                desc+= ' '+valeur+'   '
+            desc+="\n"
+        for child in node.childNodes:
+            self._currentNode=child
+            desc+=self._printNode(sep+'   ')
+            self._currentNode=node
+        return desc
+    
+    def _getTags(self,tagList):
+        node=self._currentNode
+        if node.nodeType == 1:
+            tagList.append(node.nodeName)
+        for child in node.childNodes:
+            self._currentNode=child
+            tagList = self._getTags(tagList)
+            self._currentNode=node
+        return tagList
+    
+    def _getNode(self,key,*path):        
+        try:
+            return self._searchNode(key,*path)
+        except XDRtooManyNodesException, e:
+            solverNode = self.getValue("callingAddress","action","meta")
+            solverNode= solverNode.split(".")[1]
+            return self._searchNode(key,solverNode,*path)
+
+    def _searchNode(self,key,*path):
+        """ This private method needs a key to search a node with name=key
+        If no node is found, an Exception is raisen
+        If one node is found, an Element is returned
+        If more than one node is, the most relevant one (according to path) is chosen and returned as an Element
+        
+        path is a list of keyword"""
+        
+        if not isinstance(key,basestring) :
+            raise XDRillFormed("XDRError : the type of key ", key , "is ", type(key), "instead of a basestring")      
+        
+        result=self._dom.getElementsByTagName(key)
+        if result.length==0:
+            raise XDRnoNodeException("XDRError : no node found with key "+str(key)+" and path containing "+str(path))
+        else :
+            resultToDel=[]
+            for i,elt in enumerate(result):
+                address=self._getAddress(elt)
+                for eltPath in path:
+                    if eltPath not in address:
+                        resultToDel.append(i)
+                        break
+            #Now, the result should be one item long, if not there is a problem
+            # Raising XDRnoNodeException or XDRtooManyNodesException
+            resultToDel.sort(reverse=True)
+            for i in resultToDel:
+                del result[i]
+            
+            if result.length == 1:
+                return result[0]
+            elif result.length == 0:
+                raise XDRnoNodeException("XDRError : no node found with key "+str(key)+" and path containing "+str(path))
+            else:
+
+                errMsg = "XDRError :"+str(result.length)+" nodes found with key '"+str(key)+"' and path "+str(path)+" :\n"
+                for elt in result:
+                    errMsg += str(self._getAddress(elt))+"\n"
+                raise XDRtooManyNodesException(errMsg)
+    
+    def _getAddress(self,node):
+        """ This private method constructs the address of a node in the DOM"""
+        parents=list()
+        
+        security=100
+        while (node.nodeName != '#document'):
+            security-=1
+            if security==0:
+                raise Exception("Infinite loop while searching for all the parents ...")
+            
+            parents.insert(0,node.nodeName)
+            node=node.parentNode
+        return parents
+    
+    def addChild(self,nodeName,value,fatherName,*path):
+        """
+        This method adds a child named nodeName to fatherName
+        It also sets attribute "value" to value
+        It returns the createdNode
+        """
+        fatherNode = self._getNode(fatherName,*path)
+        newNode = self._dom.createElement(nodeName)
+        
+        newNode = fatherNode.appendChild(newNode)
+        if value != "":
+            newNode.setAttribute("value", value)
+        return newNode
+    
+    def addMultipleChild(self,value,fatherName,*path):
+        """
+        This methods adds a child to a multiple node to fatherName
+        It also sets attribute "value" to value
+        It returns the createdNode name
+        """
+        
+        # Retrieve next "item" number
+        tagList= []
+        tagList = self._getTags(tagList)
+        itemList=[]
+        
+        for item in tagList:
+            p=re.compile("^item_\d+$")
+            if p.search(item):
+                itemList.append(int(item.split("_")[1]))
+                
+        itemList.sort()
+        try:
+            nextItem = "item_"+str(itemList[-1]+1)
+        except IndexError:
+            nextItem = "item_1"
+
+        self.addChild(nextItem,value,fatherName,*path)
+        
+        return nextItem
+        
+    def nodeExists(self,nodeName,*path):
+        """
+        This method tests if the node exists
+        """
+        try :
+            self._getNode(nodeName,*path)
+        except XDRnoNodeException:
+            return 0
+        else:
+            return 1
+        
+    def tryGetValue(self, default, nodeName, *path):
+        """
+        Search for the node "nodeName" with elements of "path" in its path and return its value
+        If node doesn't exist, use "default" for value
+        
+        It would be cleaner to use "path" as a list, instead of "*path", but this would change all the geValue calls :(
+        To be evaluated later
+        """
+        
+        if not isinstance(default,basestring) :
+            raise XDRillFormed("XDRError : the type of default ", default , "is ", type(default), "instead of a basestring")      
+        
+        try :
+            result = self.getValue(nodeName,*path)
+        except XDRnoNodeException:
+            result = default
+            print "Note : Could not find node \"", nodeName, " \" for path" , path ,". Using default value :", default 
+        return result
+
+    def getValue(self,nodeName,*path):
+        """
+        Search for the node "nodeName" with elements of "path" in its path and return its value
+        If node doesn't exist, XDRnoNodeException will be raised
+        
+        It would be cleaner to use "path" as a list, instead of "*path", but this would change all the geValue calls :(
+        To be evaluated later
+        """
+        node = self._getNode(nodeName, *path)
+        return node.getAttribute("value").encode("utf-8")
+
+    def getListValue(self, key, *path):
+        """
+        This procedure gets the asked value from the dataset and returns it as a list
+        """
+        result = self.getValue(key, *path).split(';')
+            
+        return result
+        
+    def setValue(self,value,nodeName,*path):
+        """
+        This method searches for the node "nodeName" with elements of "path" in its path and change its value to "value"
+        If the value is a python list, it's converted into a Tcl list
+        """
+        
+        if isinstance(value,list):
+            value2=[]
+            for elt in value:
+                value2.append(str(elt).strip())
+            value=";".join(value2)
+            
+        try :
+            node=self._getNode(nodeName, *path)
+            node.setAttribute("value",str(value))
+        except :
+            print "Note : Could not find node \"", nodeName, " \" for path" , path ,". skipping setValue"
+            
+        
+    def getChildrenName(self,nodeName,*path):
+        """
+        This method returns a list of the name of all the children of the node named "nodeName".
+        If more than one node has the same name, parts of its path can be specified as for the getValue method
+        """
+        try:
+            node=self._getNode(nodeName, *path)
+        except XDRnoNodeException:
+            return ""
+        
+        #result=list()
+        result=[child.nodeName for child in node.childNodes if child.nodeType == 1]
+            #result.append(child.nodeName)
+            
+        return result
+    
+    def removeNode(self,nodeName,*path):
+        """
+        This method removes the node named "nodeName".
+        If more than one node has the same name, parts of its path can be specified as for the getValue method
+        """
+        node=self._getNode(nodeName,*path)
+        parent = node.parentNode
+        parent.removeChild(node)
+        
+    def save2file(self,fileName):
+        """
+        This method save the dataset in C3Sm XML format
+        """
+        try:
+            f=codecs.open(fileName,"w","utf-8")
+            self._dom.writexml(f,addindent="  ",encoding="utf-8")
+            f.close()
+        except IOError:
+            error("XDRError : could not save XML content to file "+fileName+" from "+os.getcwd()+". Check path, permissions and disk space.")
+
+
+
+ #
+ #                   _ _ ______ _ _           
+ #    /\            (_|_)  ____(_) |          
+ #   /  \   ___  ___ _ _| |__   _| | ___  ___ 
+ #  / /\ \ / __|/ __| | |  __| | | |/ _ \/ __|
+ # / ____ \\__ \ (__| | | |    | | |  __/\__ \
+ #/_/    \_\___/\___|_|_|_|    |_|_|\___||___/
+ #                                            
+ #                                            
+
+        
+class WriteAsciiFile:
+    """
+    This class allows developers to easily write informations to ASCII files
+    It provides writing methods
+    """
+    def __init__(self,fileName):
+        """
+        This constructor open "fileName"
+        """
+        self._outputFile=open(fileName,"w")
+        
+    def write(self,str):
+        """
+        This method write the string "str" in the file
+        """
+        self._outputFile.write(str)
+    def writeLine(self,line):
+        """
+        This method write the string "str" followed by "\n" in the file
+        """
+        self._outputFile.write(line+"\n")
+        
+    def close(self):
+        self._outputFile.close()
+        del self
+
+
+
+
+        
+class ReadAsciiFile:
+    """ This class provides methods to read and parse ascii files"""
+    def __init__(self,fileName):
+        try:
+            self._inputFile=open(fileName,"r")
+        except IOError:
+            print "XDRError :\nThe file "+fileName+" has not been found\nPlease check that the command supposed to create it is working well\n==============="
+        self._content=self._inputFile.read()
+        self._contentList=self._content.split('\n')
+        self._inputFile.close()
+        
+        
+    def __iter__(self):
+        return self._contentList.__iter__()
+        
+    def getContent(self):
+        """
+        This method returns the content of the file
+        """
+        return self._content
+        
+
+ #
+ # _____                                          _   _                 
+ #|  __ \                                        | | (_)                
+ #| |__) |   _ _ __     ___  _ __   ___ _ __ __ _| |_ _  ___  _ __  ___ 
+ #|  _  / | | | '_ \   / _ \| '_ \ / _ \ '__/ _` | __| |/ _ \| '_ \/ __|
+ #| | \ \ |_| | | | | | (_) | |_) |  __/ | | (_| | |_| | (_) | | | \__ \
+ #|_|  \_\__,_|_| |_|  \___/| .__/ \___|_|  \__,_|\__|_|\___/|_| |_|___/
+ #                          | |                                         
+ #                          |_|                                             
+ #   
+def getRunsList():
+    """ This function returns a list containing the directories which are considered as runs
+    """
+     # Retrieve list of element in current directory
+    listElt = os.listdir(".")
+    listDir = []
+    for elt in listElt:
+        if os.path.isdir(elt):
+            # The element is a directory
+            p=re.compile('^'+PREFIX+'\d{'+str(DIGIT_NUMBER)+'}$')
+            if p.search(elt):
+                # The directory is detected as a run
+                listDir.append(elt)
+    listDir.sort()            
+    return listDir
+
+def getCurrentRun():
+    """ This function analyses the directories in the current directory and return the name of the directory corresponding to the last "run"
+    """
+    
+    # Retrieve runs list
+    listDir = getRunsList()
+   
+    
+    # Sorting the list to get the last element
+    listDir.sort()
+    if len(listDir) == 0:
+        return createNewRun()
+    return listDir[-1]
+
+def goIntoCurrentRun():
+    """ This function changes directory to go into current run directory, if no run director is present, then it creates RUN001 and goes into it
+    """
+    currentRun = getCurrentRun()
+    
+    if currentRun == "":
+        currentRun = createNewRun()
+        
+    os.chdir(currentRun)
+
+
+def formatRunNumber(int):
+    """ This function formats int to be correct towards the defined format for run number
+    """
+    formatter ="%(#)0"+str(DIGIT_NUMBER)+"d" 
+    return formatter % {"#" : int}
+
+def createNewRun():
+    """ This function creates a new directory following the last detected run.
+        It returns the name of the newly created folder
+    """
+    # Retrieve runs list
+    listDir = getRunsList()
+
+    # Sorting the list to get the last element
+    listDir.sort()
+    if len(listDir) == 0:
+        lastRun = ""
+    else:
+        lastRun = listDir[-1]
+        
+
+    #formatter = '{0:0='+str(DIGIT_NUMBER)+'d}'
+    if lastRun == "" :
+        #nextRunNumber = formatter.format(1)
+        nextRunNumber = formatRunNumber(1)
+    else:
+        p=re.compile('^'+PREFIX+'(\d{'+str(DIGIT_NUMBER)+'})$')
+        m = p.search(lastRun)
+        if m:
+            #nextRunNumber = formatter.format(int(m.group(1))+1)
+            nextRunNumber = formatRunNumber(int(m.group(1))+1)
+        else:
+            print("XDRError : Return from getLastRun function is not well formatted, contact C3Sm team ...")
+        
+    nextRun = PREFIX+nextRunNumber
+    os.mkdir(nextRun)
+    return nextRun
+
+def createNewRunFromLastRun():
+    """ This function creates a new directory following the last detected run and duplicate its content
+        It returns the name of the newly created folder
+    """
+    # Retrieve runs list
+    listDir = getRunsList()
+
+    # Sorting the list to get the last element
+    listDir.sort()
+    if len(listDir) == 0:
+        lastRun = ""
+    else:
+        lastRun = listDir[-1]
+        
+
+    #formatter = '{0:0='+str(DIGIT_NUMBER)+'d}'
+    if lastRun == "" :
+        #nextRunNumber = formatter.format(1)
+        nextRunNumber = formatRunNumber(1)
+        nextRun = PREFIX+nextRunNumber
+        os.mkdir(nextRun)
+    else:
+        p=re.compile('^'+PREFIX+'(\d{'+str(DIGIT_NUMBER)+'})$')
+        m = p.search(lastRun)
+        if m:
+            #nextRunNumber = formatter.format(int(m.group(1))+1)
+            nextRunNumber = formatRunNumber(int(m.group(1))+1)
+            nextRun = PREFIX+nextRunNumber
+            shutil.copytree(lastRun, nextRun)
+        else:
+            print("XDRError : Return from getLastRun function is not well formatted, contact C3Sm team ...")
+        
+    
+    return nextRun
+
+
+
+
+
+
+
+
+def saveDatasetInCurrentRun():
+    """ This function saves the current dataset in the last known run.
+        In order to use this function, you must have initialized the XDR library
+    """
+    if "XDR" not in sys.modules:
+        raise Exception("XDRError : XDR library is not loaded")
+    
+    try :
+        dsout = getDsout()
+    except NameError:
+        dsout = XDR.dsout() 
+    
+    currentRun = getCurrentRun()
+    dsout.save2file(os.path.join(".",currentRun,currentRun+".xml"))
+    
+
+def copyFileInLocalProject(path,tgt_dir="COMMON"):
+    """ This function copy the file path into the common directory.
+    If the file already exists, it compares the two files and rename the new one if they are different
+    It finally returns the new path
+    """
+    global COMMON_DIRECTORY,OrigAppName
+    
+    
+    
+    if tgt_dir == "COMMON" :
+        tgt_dir = COMMON_DIRECTORY
+        ensureDirectory(COMMON_DIRECTORY,clean=False)
+    else :
+        ensureDirectory(tgt_dir,clean=False)
+    
+    tgt_dir = os.path.relpath(tgt_dir,os.getcwd())
+        
+    
+        
+        
+    # Checking if original path exists
+    if not(os.path.exists(path) == True and os.path.isfile(path)):
+        msgerr =  "XDRError : the file "+path+" can't be accessed"
+        error(msgerr)
+    
+    # Checking existence of file in COMMON
+    dirName,fileName = os.path.split(path) 
+    
+    
+    newPath = os.path.join(tgt_dir,fileName)
+    
+    
+    if fileName in os.listdir(tgt_dir):
+        # The file already exists
+        print "This file already exists in "+tgt_dir
+        
+        # Checking equality
+        if filecmp.cmp(path,newPath):
+            print "File equal, skipping copy..."
+            
+        else:
+            print "Warning : File differ, previous file will be ecrased (ha ha ha)..."
+            print "Copying "+path +" in "+newPath
+            shutil.copy(path,newPath)
+    else :
+        print "Copying "+path +" in "+newPath
+        shutil.copy(path,newPath)
+    return newPath
+
+
+
+def copyFileFromDatasetInLocalProject(key,*path):
+    """ This function retrieves the path from the field identified by key and path (see getValue() )
+        It copies the file from the retrieved path into the common directory.
+        If the file already exists, it compares the two files and rename the new one if they are different
+        The function then update the field defined by key and path
+    """
+    originalPath = getValue(key,*path)
+    
+    newPath = copyFileInLocalProject(originalPath)
+    
+    setValue(newPath,key,*path)
+    return newPath
+    
+def createFileInCurrentRun(fileName,fileContent):
+    """ This function creates a new file named fileName in current run and writes fileContent into it
+    """
+    
+    currentRun = getCurrentRun()
+    
+    if currentRun == "" :
+        currentRun = createNewRun()
+    
+    filePath = os.path.join(".",currentRun,fileName)
+    f = open(filePath,"w")
+    f.write(fileContent)
+    f.close()
+    
+    return filePath
+
+
+ #
+ #_____  _                  _____           
+ #|  __ \| |                |_   _|          
+ #| |__) | |_   _  __ _ ______| |  _ __  ___ 
+ #|  ___/| | | | |/ _` |______| | | '_ \/ __|
+ #| |    | | |_| | (_| |     _| |_| | | \__ \
+ #|_|    |_|\__,_|\__, |    |_____|_| |_|___/
+ #                 __/ |                     
+ #                |___/                      
+
+
+
+class Plugin:
+    """ All the plugins inherit from this class 
+    """
+    def __init__(self,type):
+        """
+        Initializes the plugin with type = (code|tool)
+        """
+        if (type != "code") and (type != "tool"):
+            error("XDRError : Plugin type was "+type+", it has to be 'code' or 'tool'")
+        self.type = type
+        self.infos={}
+        self.infos['platform']="XDRError : Platform is not specified in current plugin"
+        self.infos['parallelCommand'] = ""
+
+        self.dir2send = []
+        self.plugin_name = self.__class__.__name__
+        self.nbcores = 0
+        self.enable_sav = False
+        
+
+    def get_cores(self):
+        if self.nbcores == 0 :
+            msg_err = "Warning : 0 cores reserved for the present computation"
+            error(msg_err)
+        return self.nbcores
+    
+
+#    def sendDirectory(self,directory):
+#        """ This method sends directory on a distant place """
+#        error("Plugin : sendDirectory() is not implemented in current plugin ...")
+
+    def executeDistantCommand(self,command,execDirectory,flags=[]):
+        """ This method goes into execDirectory and execute command """
+        error("Plugin : executeDistantCommand() is not implemented in current plugin ...")
+
+    def sendDirectory(self,directory):
+        """ This method adds a directory to the run archive. """
+        # basename(abspath()) removes the trailing '/'s.
+        #local_directory = os.path.abspath(directory)
+        #directory_name = os.path.basename(local_directory)
+
+        local_directory = os.path.relpath(directory)
+
+        # We don't check that relpath doesn't contain some '../../../'.
+        # Might be an issue.
+        # tar removes them on its own, a plain scp might not.
+
+        # Also, handling of symlinks is unknown.
+        
+        # Check that directory exists
+        if not os.path.exists(local_directory):
+            error("Error : " + directory + " doesn't exist")
+
+        # Check that we didn't change working directory along the way.
+        if (len(self.dir2send) > 0):
+            if os.getcwd() != self._dir2send_curdir:
+                error("Current directory changed between calls to sendDirectory(). This is not supported !")
+        else:
+            self._dir2send_curdir = os.getcwd()
+
+        # Add to the list of files to be sent        
+        self.dir2send.append(local_directory)
+
+    def retrieveDirectory(self,directory):
+        """ This method retrieves directory from the distant place """
+        error("Plugin : retrieveDirectory is not implemented in current plugin ...")
+        
+    def removeDirectory(self,directory):
+        """ This method removes directory from the distant place """
+        error("Plugin : removeDirectory is not implemented in current plugin ...")
+    
+    def getPlatform(self):
+        """ This method has to be deleted
+        """
+        error("Plugin : getPlatform souldn't be called anymore")
+        
+    def getInfos(self):
+        """ This methods returns informations regarding the plugin as a dictionary.
+        This dictionary is instantiated in the constructor of mother class Plugin
+        This method has to be deleted
+        """
+        error("Plugin : getInfos souldn't be called anymore")
+        
+    def getPluginParam(self,paramName):
+        """ This method searches for paramName where the plugin is configurated and return its value
+        """
+        try:
+            return getValue(paramName,self.__class__.__name__,self.type+"_plugins")
+        except XDRtooManyNodesException:
+            #error("Your plugin "+self.__class__.__name__+" is configurated in multiple places ...\n Remove it from your config !")
+            return getValue(paramName,self.__class__.__name__,self.type+"_plugins",getValue("name","solver","meta"))
+
+    def runSAV(self):
+        if not self.enable_sav:
+            print "SAV not available for current plugin"
+            return
+
+        shutil.copy(os.path.join(os.path.dirname(os.path.abspath(__file__)), "SAV.py"), ".")
+        self.sendDirectory('SAV.py')
+        self.executeDistantCommand("python SAV.py", ".", "SAV")
+        self.retrieveDirectory('XDR-FileDB.csv')
+
+        db = SAV.FileDB('XDR-FileDB.csv')
+        print db
+
+
+
+
+
+def loadPlugin(pluginName):
+    
+    callDir = os.path.split(scriptDir)[1]
+    #print callDir
+    #pluginPath = ""
+    #if callDir == "XDRpy" :
+    #    pluginPath = os.path.join(scriptDir,"..","library","DATA","pluginscripts")
+    #if callDir == "scripts" :
+    #    pluginPath = os.path.join(scriptDir,"..","..","DATA","pluginscripts")
+    #    
+    #if pluginPath == "" :
+    #    error("Problem, this case is not managed by load plugin")
+    pluginsPath = getValue("pluginsPath","engine","meta")
+
+    print "Loading plugin : "+str(os.path.join(pluginsPath,pluginName+".py"))
+    
+ 
+    try:
+        return imp.load_source(pluginName,os.path.join(pluginsPath,pluginName+".py"))
+    except IOError:
+        error("XDRError : plugin \""+pluginName+"\" couldn't be found")
+
+
+
+def loadCodePlugin(pluginName=""):
+    
+    if pluginName == "" :
+        try:
+            pluginName = getValue("code_plugins")
+        except XDRtooManyNodesException:
+            #error("Your plugin "+self.__class__.__name__+" is configurated in multiple places ...\n Remove it from your config !")
+            pluginName = getValue("code_plugins",getValue("name","solver","meta"))
+
+    pluginLib = loadPlugin(pluginName)
+    pluginClass = getattr(pluginLib,pluginName)
+    plugin = pluginClass("code")
+    return plugin
+
+def loadToolPlugin():
+    try:
+        pluginName = getValue("tool_plugins","config")
+    except XDRnoNodeException:
+        error("XDRError : Your config file is not up to date")
+        
+    
+    pluginLib = loadPlugin(pluginName)
+    pluginClass = getattr(pluginLib,pluginName)
+    plugin = pluginClass("tool")
+    return plugin
+
+
+def executeTool(command,directory):
+    """ This command execute a tool on a distant service regarding the chosen plugin in config file
+    """
+   
+    
+    plugin = loadToolPlugin()
+
+    plugin.sendDirectory(directory)
+    
+    plugin.executeDistantCommand(command,directory)
+    
+    plugin.retrieveDirectory(directory)
+
+
+ #           ______                                                              _ 
+ #   ____   |  ____|                                                            | |
+ #  / __ \  | |__  __  _____  ___   ___ ___  _ __ ___  _ __ ___   __ _ _ __   __| |
+ # / / _` | |  __| \ \/ / _ \/ __| / __/ _ \| '_ ` _ \| '_ ` _ \ / _` | '_ \ / _` |
+ #| | (_| | | |____ >  <  __/ (__ | (_| (_) | | | | | | | | | | | (_| | | | | (_| |
+ # \ \__,_| |______/_/\_\___|\___| \___\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_|
+ #  \____/                     ______                                              
+ #                            |______|                                             
+
+
+def exec_command(fun):
+    """ This function defines the annotation @exec_command, to be used by all plugin scripts.
+       It defines self.command_exe (defaults to command), self.local_directory (the current directory)
+       that can then be accessed in executeDistantCommand """
+    def wrapped_fun(self, command, execDirectory, appli, flags=[]):
+        print "Plugin : Running executeDistantCommand " + command + " (appli: " + appli + ") in " + execDirectory
+        
+        # Initialize some variables
+        self.command_exe = command
+        self.local_directory = os.getcwd()
+
+        # Used only for testing deployment plugins
+        if appli == "-c3sm_auto_deployment_tests":
+            if command == "-c3sm_auto_deploy_test_write-":
+                self.command_exe = "cat my_input_file > my_new_file"
+
+        # Check that execDirectory makes sense
+        if len(execDirectory) == 0:
+            print "No execDirectory given. Assuming '.'"
+            execDirectory = '.'
+        
+        if execDirectory[0] == '/' or execDirectory[0] == '~':
+            error("execDirectory should be relative to the project directory, not an absolute path")
+
+        # Run the actual command
+        r = fun(self, command, execDirectory, appli, flags=[])
+
+        # The command is supposed to have uploaded pending files
+        # Empty the list, so they aren't sent again if we invoke executeDistantCommand another time.
+        self.dir2send = []
+
+        # Make sure we get back to the initial directory
+        os.chdir(self.local_directory)
+    return wrapped_fun
+
+ #
+ #            _____                              _           _                    _ _           _   _                 
+ #   ____    / ____|                            | |         | |                  | (_)         | | (_)                
+ #  / __ \  | (___  _   _ _ __  _ __   ___  _ __| |_ ___  __| |  __ _ _ __  _ __ | |_  ___ __ _| |_ _  ___  _ __  ___ 
+ # / / _` |  \___ \| | | | '_ \| '_ \ / _ \| '__| __/ _ \/ _` | / _` | '_ \| '_ \| | |/ __/ _` | __| |/ _ \| '_ \/ __|
+ #| | (_| |  ____) | |_| | |_) | |_) | (_) | |  | ||  __/ (_| || (_| | |_) | |_) | | | (_| (_| | |_| | (_) | | | \__ \
+ # \ \__,_| |_____/ \__,_| .__/| .__/ \___/|_|   \__\___|\__,_| \__,_| .__/| .__/|_|_|\___\__,_|\__|_|\___/|_| |_|___/
+ #  \____/               | |   | |                          ______   | |   | |                                        
+ #                       |_|   |_|                         |______|  |_|   |_|                                        
+
+def supported_applications(apps):
+    """ Annotation @supported_applications(['appli1', 'appli2']) automates checking that a passed application is supported """
+    def wrapper(fun):
+        def wrapped_fun(self, command, execDirectory, appli, flags=[]):
+            # This is a list of apps that the user doesn't have to specifically accept.
+            # XDRpy will handle them internally, and developers of deployment plugins
+            # don't have to care about them.
+            apps_whitelist = ['-c3sm_auto_deployment_tests', 'SAV']
+
+            if (appli not in apps) and (appli not in apps_whitelist):
+                error("This application requires the application tag " + appli + ", which is not supported by the plugin " + self.plugin_name)
+            return fun(self, command, execDirectory, appli, flags=[])
+        return wrapped_fun
+    return wrapper
+
+def check_command_exe(command_exe):
+    """ Checks that the command is valid. If it starts with -c3sm_auto-, the associated command hasn't been found """
+    if command_exe.startswith("-c3sm_auto_"):
+        error("command was not understood: "+command_exe )
+
+    
+def executeCode(command,currentRunDirectory="None"):
+    
+    
+    error("XDRError : executeCode is not managed anymore in XDR library, update your library")
+    
+    try:
+        pluginName = getValue("code_plugins","config")
+    except XDRnoNodeException:
+        error("XDRError : Your config file is not up to date")
+        return
+    
+    if currentRunDirectory=="None" :
+        currentRunDirectory = getCurrentRun()
+    
+    typeRun = "code"
+    
+    plugin = loadPlugin(pluginName)
+    
+    plugin.sendDirectory(os.path.join(".",COMMON_DIRECTORY),typeRun)
+    
+    plugin.sendDirectory(os.path.join(".",getCurrentRun()),typeRun)
+    
+    plugin.executeDistantCommand(command,currentRunDirectory,typeRun)
+    
+def retrieveCodeDirectory(directory):
+    try:
+        pluginName = getValue("code_plugins","config")
+    except XDRnoNodeException:
+        print "XDRError : Your config file is not up to date"
+        return
+    
+    plugin = loadPlugin(pluginName)
+    
+    plugin.retrieveDirectory(directory,"code")
+    
+    
+    
+
+ #
+ #
+ # ______                    _   _                 
+ #|  ____|                  | | (_)                
+ #| |__  __  _____ ___ _ __ | |_ _  ___  _ __  ___ 
+ #|  __| \ \/ / __/ _ \ '_ \| __| |/ _ \| '_ \/ __|
+ #| |____ >  < (_|  __/ |_) | |_| | (_) | | | \__ \
+ #|______/_/\_\___\___| .__/ \__|_|\___/|_| |_|___/
+ #                    | |                          
+ #                    |_|                          
+ #
+
+class XDRException(Exception):
+    """ All exceptions raisen by XDR library inherits from this one"""
+    
+class XDRnoNodeException(XDRException):
+    """" No node found """
+
+class XDRtooManyNodesException(XDRException):
+    """ Too many nodes have been found"""
+        
+class XDRnoFileException(XDRException):
+    """ No file found """
+
+class XDRillFormed(XDRException):
+    """ Ill formed XML address """
+
+
+
+
+def replace_pattern_in_file(file,searchExp,replaceExp):
+    """ serach and replace a pattern in a file
+    needs the fileinput package"""
+    
+    if not os.path.exists(file) :
+        print "Warning : file not found:"+file
+        return
+    
+    replace = 0
+    for line in fileinput.input(file, inplace=1):
+        if searchExp in line:
+            line = line.replace(searchExp,replaceExp)
+            replace += 1
+        sys.stdout.write(line)
+        
+    if replace == 0 :
+        print "Warning : no replacement made \n "+file+":"+ searchExp +">"+replaceExp
+    else :
+        print str(replace)+" replacement made \n"+file+":"+ searchExp +">"+replaceExp
+    return
+        
+ #       
+ # ______                               _                _   _                 
+ #|  ____|                             | |              | | (_)                
+ #| |__ _ __ ___  __ _ _   _  ___ _ __ | |_    __ _  ___| |_ _  ___  _ __  ___ 
+ #|  __| '__/ _ \/ _` | | | |/ _ \ '_ \| __|  / _` |/ __| __| |/ _ \| '_ \/ __|
+ #| |  | | |  __/ (_| | |_| |  __/ | | | |_  | (_| | (__| |_| | (_) | | | \__ \
+ #|_|  |_|  \___|\__, |\__,_|\___|_| |_|\__|  \__,_|\___|\__|_|\___/|_| |_|___/
+ #                  | |                                                        
+ #                  |_|                                                        
+
+    
+def afterstring(text,pattern):
+    """
+    This procedure searches for the first line beginning with "pattern" in "text" and return the rest of the line
+    """
+    p= re.compile('^[ \t]*'+pattern+'[\t ]*(.*?)[ \t]*$', re.MULTILINE)
+    m=p.search(text)
+    if m:
+        return m.group(1)
+    else:
+        print "No result found for "+pattern+" ..."
+        return "Error"
+    
+
+def grep(text,pattern):
+    textLines=text.split("\n")
+    p= re.compile(pattern)
+    result=[]
+    for line in textLines:
+        m=p.search(line)
+        if m:
+            result.append(line)
+    return "\n".join(result)
+    
+    
+def betweenlines(text,pattern1,pattern2):
+    """
+    This procedure return the text between the lines "pattern1" and "pattern2"
+    """
+    textLines=text.split("\n")
+    p=re.compile('^[ \t]*'+pattern1+'[ \t]*$')
+    position="out"
+    result=[]
+    for line in textLines:
+        m=p.search(line)
+        if m:
+            if position=="out":
+                p=re.compile('^[ \t]*'+pattern2+'[ \t]*$')
+                position="in"
+            else:
+                position="out"
+        else:
+            if position=="in":
+                result.append(line)
+    return "\n".join(result)
+
+
+def getColumn(text,pos,sep=None):
+    """ This procedure reads the lines of "text" and return an array containing the pos-th element of each line
+    sep is the separator, if not specified, the separator is assumed to be any kind of whitespace (tab, space, etc ...)
+    """
+    finalList = []
+    result=text.split("\n")
+    for line in result:
+        toto=line.split(sep)
+        if len(toto)>=pos:
+            finalList.append(toto[pos-1].strip())
+    return finalList
+
+    
+def readFile(filename):
+    """ This procedure returns the content of the file "filename" """
+#    asciiIn = ReadAsciiFile(filename)
+#    result = asciiIn.getContent()
+    return ReadAsciiFile(filename).getContent()
+    
+    
+
+
+def pairwise(iterable):
+    """
+    This procedure allows to loop in a list in a pairwise fashion
+    need package izip
+    s -> (s0,s1), (s2,s3), (s4, s5), ...
+    """
+    a = iter(iterable)
+    return izip(a, a)
+        
+def ensureDirectory(list_strings,clean=False):
+    """ Check wether a directory exists in the current working directory
+    argument is a list of strings to be contcatenated.
+    Returns the directory path in absolute form
+    """
+    
+    if isinstance(list_strings, basestring) :
+        dirlist = [list_strings]
+    else :
+        dirlist = list_strings
+    
+        
+    directory= os.path.join(os.getcwd(),*dirlist)
+ 
+    
+    if os.path.exists(directory) :
+        if clean :
+            print "Ensure clean directory", directory
+            # directory exists, and need to clean it 
+            shutil.rmtree(directory)
+            os.makedirs(directory)
+        else :
+            # directory exists, and no need to clean it
+            pass
+            
+    else :
+        #directory does not exists
+        print "Create directory", directory
+        os.makedirs(directory)
+    
+   
+    
+    return directory
+
+def readAsciiBound(asciiBoundFile):
+    asciiBound = readFile(asciiBoundFile)
+    asciiBound = asciiBound.split("\n")
+   
+    nbPatches = int(asciiBound[1].strip().split(" ")[0])
+
+    results= []
+    for i,line in enumerate(asciiBound):
+        if re.compile("^\s*Patch: ").search(line):
+            results.append(asciiBound[i+1].strip())
+
+    if len(results) != nbPatches:
+        msg = "Mismatch between the number of patches and the patches read in file "+asciiBoundFile
+        error(msg)
+
+    return results
+
+
+def getFileList(path,filter_search="",output="listonly"):
+    """ return the list of files in a path (compulsory) matching a filter string (facultative).
+    output (facultative) can be : - listonly : a list of the files
+                                  - relative : a list relative pathes
+                                  - absolute : a list of absolute path
+    """
+    
+    
+    lresult =  []
+    glob_arg = os.path.join(path,filter_search)
+    list_dir = glob.glob(glob_arg)
+    
+    
+    if output == "relative" :
+        for f in list_dir:
+                lresult.append(os.path.relpath(f))
+    if output == "listonly" :
+         for f in list_dir:
+                lresult.append(os.path.relpath(f,path))
+    if output == "absolute" :
+        lresult = list_dir
+
+    #print "getFileList",lresult
+    
+   
+    return sorted(lresult)
+
+
+
+ #
+ # _____  __  __         _   _ _     
+ #|  __ \|  \/  |       | | (_) |    
+ #| |__) | \  / |  _   _| |_ _| |___ 
+ #|  ___/| |\/| | | | | | __| | / __|
+ #| |    | |  | | | |_| | |_| | \__ \
+ #|_|    |_|  |_|  \__,_|\__|_|_|___/
+ #                                   
+                                    
+def SimToColor(simu) :
+    color = "black"
+    if simu == "1" :
+        color="black"
+    if simu == "2" :
+        color="red"
+    if simu == "3" :
+        color="blue"
+    if simu == "4" :
+        color="green4"    
+    return color
+
+def SimToSymbol(simu) :
+    symbol = ""
+    if simu == "1" :
+        symbol="circle"
+    if simu == "2" :
+        symbol="square"
+    if simu == "3" :
+        symbol="triangle"
+    if simu == "4" :
+        symbol="diamond"
+    return symbol
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/data3d.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/data3d.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/data3d.py	(revision 4775)
@@ -0,0 +1,92 @@
+#!/usr/bin/env python
+
+from itertools import izip
+from math import sqrt,atan2,pi,hypot,cos,sin
+
+def grouped(iterable, n):
+    "s -> (s0,s1,s2,...sn-1), (sn,sn+1,sn+2,...s2n-1), (s2n,s2n+1,s2n+2,...s3n-1), ..."
+    return izip(*[iter(iterable)]*n)
+
+def norm(u):
+    return sqrt(u["x"]**2+u["y"]**2+u["z"]**2)
+
+
+def rotate(y,z,rotate_deg):
+    r = hypot(z,y)
+    theta = atan2(z,y) + rotate_deg*pi/180
+    y = r*cos(theta)
+    z = r*sin(theta)
+    return [y,z] 
+    
+
+def makevect(points,a,b):
+    res = {}
+    res["x"] = points[b,"x"] - points[a,"x"]
+    res["y"] = points[b,"y"] - points[a,"y"]
+    res["z"] = points[b,"z"] - points[a,"z"]
+    return res
+
+   
+def pvect(u,v):
+    res = {}
+    res["x"] = u["y"]*v["z"]- u["z"]*v["y"]
+    res["y"] = u["z"]*v["x"]- u["x"]*v["z"]
+    res["z"] = u["x"]*v["y"]- u["y"]*v["x"]
+    return res
+
+
+def getparts(data,subpart=""):
+    if subpart != "" :
+        subpart = "."+subpart
+    res = None
+    i = data.index("root"+subpart+".children :")
+    i+=1
+    res = data[i].strip().split(",")    
+    return res
+    
+def dumpparts(list_parts,subpart=""):
+    if subpart != "" :
+        subpart = "."+subpart
+    res = "root"+subpart+".children :\n"+ ",".join(list_parts)+"\n\n"
+    return res
+
+def getfield(part,field,data,datatype="integer",subpart=""):
+    if subpart != "" :
+        subpart = "."+subpart
+    
+    i = data.index("root."+part+subpart+"."+field+" :")
+    i +=1
+    j = i
+    while data[j] != "" :
+        j += 1
+    out = filter(None,",".join(data[i:j]).split(","))
+    
+    
+    if field == "children" :
+        datatype = "spacedstring"
+    
+    
+    if datatype == "spacedstring":
+        pass
+    if datatype == "float":
+        out  =[float(x) for x in out]
+    if datatype == "integer":
+        out  =[int(x) for x in out]        
+    return out
+    
+def dumpfield(part,field,listdata,subpart="") :
+    if subpart != "" :
+        subpart = "."+subpart
+        
+    dump = "root."+part+subpart+"."+field+" :\n"
+    maxcol = 10
+    col = 1
+    for item in listdata:
+        dump += str(item) +","
+        if col == maxcol :
+            dump += "\n"
+            col = 1
+        col += 1
+    
+    dump += "\n\n"
+    return dump
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/dsgraph_utilities.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/dsgraph_utilities.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/dsgraph_utilities.py	(revision 4775)
@@ -0,0 +1,96 @@
+#!/usr/bin/env python
+
+
+#######################################
+#
+# Projet Manager Graph Dataset utilities
+#
+########################################
+# This class allows to handle a the datasets stored in xml files
+# for further datamining thourough the compare widget
+#
+# Created by A. Dauptain
+#
+# Last modified : 16 septembre 2013 A Dauptain (comments)
+#                
+########################################
+
+
+import os
+from XDR import getFileList
+
+
+class DSGraph_Utilities(object):
+    def __init__(self,code_id):
+        self.solver = code_id
+        self.post_proc_dir = os.path.join(os.getcwd(),code_id.upper(),"COMPARE")
+        self.runlist = []
+        
+        # cleaning
+        for f in getFileList(self.post_proc_dir,"*.dat","relative") :
+            print "Cleaning file :",f
+            os.remove(f)
+
+
+    def DatasetDump(self,ds,simu,project_name,run_name):
+        """ This procedure dup the content of an XML file in a key/value file
+        , to be read afterward for comparisons """
+        
+        run_id = "Sim."+simu+"#"+project_name+"#"+run_name
+        self.runlist.append(run_id)
+        
+       
+        
+        address = []
+        address.append("dataset")
+        
+        arraylist = []
+        #point de depart
+        arraylist.append('dataset-value= \n')
+        arraylist.append("dataset-children= "+self.solver+"\n")
+        address.append(self.solver)
+        
+        # EXTENSION PAR RECURSION
+        arraylist.extend(self.DatasetDumpIterate(ds,address))
+        
+        # SAUVEGARDE
+        filename=os.path.join( self.post_proc_dir, run_id+".dat")
+        tracefile = open(filename, 'w')
+        tracefile.writelines(arraylist)
+        tracefile.close()
+        
+    
+    def DatasetDumpIterate(self,ds,address):
+        """ This procedure is the iterative part of DatasetDump procedure """
+         
+        dsadr = []
+        arraylist=[]
+        dsadr.append(address[-1])
+        
+       
+        
+        dsadr.extend(address[0:-1])
+        value=ds.getValue(*dsadr)
+        if type(value) is list:
+            value=" ".join(value)
+            
+        listChildren = ds.getChildrenName(*dsadr)
+        for banned in ["avbp_db","scriptNode", "projcontent"]:
+            if banned in listChildren :
+                listChildren.remove(banned)
+        
+        arraylist.append(".".join(address)+'-value= '+str(value)+'\n')
+        arraylist.append(".".join(address)+"-children= "+" ".join(listChildren)+"\n")
+        
+        
+        
+        for child in listChildren: 
+            newaddress=list(address)
+            newaddress.append(child)
+            arraylist.extend(self.DatasetDumpIterate(ds,newaddress))        
+        return arraylist
+
+
+
+if __name__ == '__main__':
+    pass # Do tests
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/enspython_cut.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/enspython_cut.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/enspython_cut.py	(revision 4775)
@@ -0,0 +1,159 @@
+#!/usr/bin/env python
+import os
+
+class EnsPythonCut(object):
+    def __init__(self, filename):
+        self.filename = filename
+        
+        self.fileid = open(filename,"w")
+        
+        self.ppdir = os.path.dirname(filename)
+
+    def writeHeader(self):
+        """Header Of all ensight python scripts"""
+        self.fileid.write("""
+
+#image resolution and filename
+XRESOLUTION=800
+YRESOLUTION=600
+COLORMIN=0
+COLORMAX=1
+OUTPATHFILE='./'  # trailing / needed ! 
+CASEFILE='{0}'
+
+ensight.part.select_default()
+ensight.part.modify_begin()
+ensight.part.elt_representation("3D_feature_2D_full")
+ensight.part.modify_end()
+ensight.data.binary_files_are("native")
+ensight.data.format("Xdmf2")
+ensight.data.shift_time(1.000000,0.000000,0.000000)
+ensight.data.replace(CASEFILE)
+""".format(os.path.join(self.ppdir,'c3sm_xdmfgroup.xmf')))
+        self.fileid.flush()
+
+    def writeBody(self,cuttype,direction,pos,var,list_ids): 
+        """Make cuts and save images"""
+    
+        self.fileid.write("""
+print "Defining functions ...",
+
+def print_image(file):
+  
+  ensight.file.image_format("gif")
+  ensight.file.image_format_options("Compression Default")
+  ensight.anim_recorders.render_offscreen("ON")
+  ensight.file.image_numpasses(4)
+  ensight.file.image_stereo("current")
+  ensight.file.image_screen_tiling(1,1)
+  ensight.file.image_file(OUTPATHFILE+file)
+  ensight.file.image_window_size("user_defined")
+  ensight.file.image_window_xy(XRESOLUTION,YRESOLUTION)
+  ensight.file.save_image()
+
+  return
+
+def cut(axis,value,part):
+  ensight.part.select_begin(part)
+  ensight.clip.begin()
+  ensight.clip.mesh_plane(axis)
+  ensight.clip.value(value)
+  ensight.clip.tool("xyz")
+  ensight.clip.end()
+  ensight.clip.create()
+  ensight.clip.domain("crinkly")
+  ensight.part.select_end(part)
+
+  return
+
+def cylinder(Origin,axis,radius,part):
+  ensight.part.select_begin(part)
+  ensight.clip.begin()
+  ensight.clip.extents("infinite")
+  ensight.clip.tool("cylinder")
+  ensight.clip.origin(Origin[0],Origin[1],Origin[2])
+  ensight.clip.axis(axis[0],axis[1],axis[2])
+  ensight.clip.radius(radius)
+  ensight.clip.end()
+  ensight.clip.create()
+  ensight.part.select_end(part)
+
+def color(variable,part):
+  ensight.part.select_begin(part)
+  ensight.part.modify_begin()
+  ensight.part.colorby_palette(variable)
+  ensight.function.palette("abspress")
+  ensight.function.range(COLORMIN,COLORMAX)
+  ensight.part.modify_end()
+  ensight.part.select_end(part)
+
+  return
+
+def hide(part):
+  ensight.part.select_begin(part)
+  ensight.part.modify_begin()
+  ensight.part.visible("OFF")
+  ensight.part.modify_end()
+  ensight.part.select_end(part)
+
+def hide_legend(variable):
+  ensight.legend.select_palette_begin(variable)
+  ensight.legend.visible("OFF")
+
+
+def legend(variable,VARTITLE,var_range_min,var_range_max):
+  ensight.function.palette(variable)
+  ensight.function.modify_begin()
+  ensight.function.range(float(var_range_min),float(var_range_max))
+  ensight.legend.select_palette_begin(variable)
+  ensight.legend.title_name(VARTITLE)
+  ensight.legend.format("%.2f")
+
+print "Done"
+
+#ensight.sendmesgoptions(exception=1,display=1)
+ensight.viewport.select_begin(0)
+ensight.viewport.background_type("constant")
+ensight.viewport.select_end(0)
+
+
+""")
+
+        self.fileid.write(cuttype+"('"+direction+"','"+pos+"',1)\n")
+        self.fileid.write("hide(1)\n")
+        self.fileid.write("color('"+var+"',2)\n")
+        self.fileid.write("legend('"+var+"','"+var+"',0,1)\n")
+        
+        self.fileid.write("ensight.part.select_begin(2)\n")
+        self.fileid.write("ensight.view_transf.view_recall('+"+direction+"')\n")
+        self.fileid.write("ensight.view_transf.fit(2)\n")
+        self.fileid.write("ensight.part.select_end(2)\n")
+ 
+
+        self.fileid.write("""
+ensight.text.new_text('Simulation')
+ensight.text.location_x(5.000000e-01)
+ensight.text.location_y(1.50000e-01)
+ensight.text.size(40)
+""")
+    
+    
+        for current_step in range(0,len(list_ids)):
+            
+            self.fileid.write("ensight.solution_time.current_step("+str(current_step)+")\n")
+            self.fileid.write("ensight.solution_time.update_to_current()\n")
+            self.fileid.write("ensight.text.select_begin(0)\n")
+            self.fileid.write("ensight.text.change_text('"+list_ids[current_step].replace("#","<cr>")+"')\n")
+            self.fileid.write("ensight.text.select_end(0)\n")
+            #fileid.write('ensight.file.image_convert("ON")\n')
+            self.fileid.write("print_image('./"+var+"_"+str(current_step)+"_"+list_ids[current_step].replace("#","_")+"')\n")
+            #fileid.write('ensight.file.image_convert("OFF")\n')
+
+        self.fileid.flush()
+
+    def close(self):
+        self.fileid.close()
+
+
+if __name__ == '__main__':
+    pass # Do tests
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/hello.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/hello.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/hello.py	(revision 4775)
@@ -0,0 +1,12 @@
+from XDR import *
+
+init()
+
+print "hello world!"
+
+
+plugin = loadCodePlugin()
+
+
+
+finish()
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/html_writers.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/html_writers.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/html_writers.py	(revision 4775)
@@ -0,0 +1,235 @@
+import os
+
+#### FOR HTML OUTPUTS #####
+
+class HtmlWriters(object):
+    def __init__(self):
+        pass
+
+
+    def html_header(self,title):
+        """ create the header for c3s HTML docs """
+        header = """
+<html>
+<body>
+<head>
+<title> """+ title + """
+</title>
+<style>
+html { min-height:100%; } /* to get the gradient to stetch to the bottom of the view port */
+body {
+        background: #c1c1c1;
+        background: -moz-linear-gradient(left, #ffffff 0%, #c1c1c1 100%), url(img.png) no-repeat 50% 300px;
+        background: -webkit-gradient(linear, 100% 0%,0% 0%, from(#ffffff), to(#c1c1c1)), url(img.png) no-repeat 50% 300px;
+        background: -webkit-linear-gradient(left, #ffffff 0%,#c1c1c1 100%), url(img.png) no-repeat 50% 300px;
+        background: -o-linear-gradient(left, #ffffff 0%,#c1c1c1 100%), url(img.png) no-repeat 50% 300px;
+        background: -ms-linear-gradient(left, #ffffff 0%,#c1c1c1 100%), url(img.png) no-repeat 50% 300px;
+        background: linear-gradient(left, #ffffff 0%,#c1c1c1 100%), url(img.png) no-repeat 50% 300px;
+        margin-top:100px;
+        margin-bottom:100px;
+        margin-right:50px;
+        margin-left:50px;
+}
+h1 {
+
+}
+h2 {
+padding-left:10px;
+}
+h3 {
+padding-left:20px;
+}
+h4 {
+padding-left:40px;
+}
+h5 {
+padding-left:50px;
+}
+p {
+padding-left:50px;
+}
+</style>
+</head>
+"""
+        return header
+        
+    def html_closing(self):
+        """ append to and html file before closure"""
+        closing = "</html></body>"    
+        
+        return closing
+        
+        
+    def html_create_image(self,filename):
+        img_declare = []
+        img_declare.append('<div id="wrapper" style="width:100%; text-align:center">\n')
+        img_declare.append('<img src="'+filename+'"; style="margin:auto;">\n')
+        
+        
+        captionfile = filename.replace(".gif",".txt")
+        if os.path.exists(captionfile):
+            img_declare.append("<br>")
+            print "Debug : a txt exists"
+            tmpfile= open(captionfile, 'r')
+            caption_text= tmpfile.readlines()
+            tmpfile.close()
+            for line in caption_text :
+                 img_declare.append(line.replace("\n","<br>"))
+            
+        img_declare.append("</div>\n")
+        print img_declare
+    
+        return img_declare
+    
+    def html_create_table(self,caption,list_header,content):
+        """ create an html table, output is a list to write in a file"""
+        
+        linelist = []
+        linelist.append("<table border='1'>\n")
+        linelist.append("<caption>"+caption+"</caption>\n")
+        
+        linelist.append("    <tr>\n")
+        for header in list_header:
+            linelist.append("         <th>"+header+"</th>\n")
+        linelist.append("    </tr>\n")
+        
+        for lines in content :
+            
+            linelist.append("    <tr>\n")
+            for cell in lines :
+                # intelligent line wrapper, for pathes and spaces.
+                final_cell= ""
+                maxlenght=35
+                
+                # the '#' symbol is used in comments to skip a line
+                for sentence in cell.split("#"):
+                    if len(sentence) < maxlenght :
+                        final_cell+=sentence+"<br>"
+                    else :
+                        # cut sentences btw words
+                        bit = ""
+                        stage1 = ""
+                        for word in sentence.split(" "):
+                            bit+=" "+word
+                            if len(bit) > maxlenght:
+                                stage1+=bit+"<br> "
+                                bit=""
+                        
+                        stage1+=bit+"<br> "
+                        
+                        final_cell = stage1
+                        
+                        
+                        if len(final_cell.split("/")) > 1:
+                            bit = ""
+                            stage2 = ""
+                            for word in final_cell.split("/"):
+                                bit+="/"+word
+                                if len(bit) > maxlenght:
+                                    stage2+=bit+"<br> "
+                                    bit=""
+                                
+                            stage2+=bit+"<br> "
+                            final_cell=stage2
+                    
+                linelist.append("      <td>"+final_cell+"</td>\n")
+            linelist.append("    </tr>\n")
+        
+        linelist.append("</table>\n")
+    
+        
+        return linelist
+        
+        
+    def html_add_toc (self,filename):
+        """ add a table of content based on headers to an html file"""
+        initfile =  open(filename,"r")
+        lines = initfile.readlines()
+        initfile.close()
+        
+        lines_changed=[]
+        menu=[]
+        
+        ref_h1 = 0
+        ref_h2 = 0
+        ref_h3 = 0
+        ref_h4 = 0
+        
+        h1tags=['','A.','B.','C.','D.','E.','F.','G.','H.','I.','J.']
+        h2tags=['','I.','II.','III.','IV.','V.','VI.','VII.','VIII.','IX.','X.','XI.','XII.','XIII.','XIV.','XV.','XVI.','XVII.','XVIII.','XIX.','XX.' ]
+        h3tags=['','1.','2.','3.','4.','5.','6.','7.','8.','9.','10.','11.','12.','13.','14.','15.','16.','17.','18.','19.','20.' ]
+        h4tags=['','1.','2.','3.','4.','5.','6.','7.','8.','9.','10.','11.','12.','13.','14.','15.','16.','17.','18.','19.','20.' ]
+        
+        # parsing document
+        for line in lines :
+            newline=line
+            
+            for balise in ['h1', 'h2', 'h3', 'h4'] :
+                if line.startswith('<'+balise+'>'):
+                    title=line.split('</')[0]
+                    title=title.split('>')[1]
+                    
+                    if balise == 'h1' :
+                        ref_h1 +=1
+                        ref_h2 = 0
+                        ref_h3 = 0
+                        ref_h4 = 0
+                        
+                        
+                        
+                    if balise == 'h2' :
+                        ref_h2 +=1
+                        ref_h3 = 0
+                        ref_h4 = 0
+                        
+                    if balise == 'h3' :
+                        ref_h3 +=1
+                        ref_h4 = 0
+                        
+                        
+                    if balise == 'h4' :
+                        ref_h4 +=1
+                        
+                    h1tag=h1tags[ref_h1]
+                    h2tag=h2tags[ref_h2]
+                    h3tag=h3tags[ref_h3]
+                    h4tag=h4tags[ref_h4]
+                        
+                    
+                    tag = h1tag+h2tag+h3tag+h4tag
+                    
+                    
+                    newline = '<'+balise+'>'+ tag + ' ' +title +' <a name=title_'+tag+'></a> </'+ balise +'>'
+                    newmenu = '<'+balise+'> <a href="#title_'+tag+'">'+ tag +' '+title +'</a></'+ balise +'>'
+                    menu.append(newmenu)
+                    
+            lines_changed.append(newline)
+        
+        # creating the final document by adding menu
+        final_lines = []
+        for line in lines_changed :
+            final_lines.append(line)
+            if line.strip()=="</head>" :
+                final_lines.extend(menu)
+            
+        
+        newhtml = open(filename, 'w')
+        newhtml.writelines(final_lines)
+        newhtml.close()
+        
+        return
+        
+    def get_html_content(self,filename):
+        html_list=[]
+        
+        if os.path.exists(filename):
+            tmpfile= open(filename, 'r')
+            html_list= tmpfile.readlines()
+            tmpfile.close()
+        else :
+            html_list.append("File "+filename+" is not created yet...\n" )
+        
+        return html_list
+
+if __name__ == '__main__':
+    pass # Do tests
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/pckgfile.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/pckgfile.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/pckgfile.py	(revision 4775)
@@ -0,0 +1,170 @@
+import os
+
+def link2path(filename):
+    return os.path.realpath(filename)
+      
+class PckgDefaultFile:
+    def __init__(self,pckgname,mode,compression=None):
+        self.pckgname=pckgname
+        self.mode=mode
+        self.compression=compression
+        self.debug=0
+
+    def close(self):
+        try:    return self.pckg.close()
+        except: return -1
+
+class PckgZipFile(PckgDefaultFile):
+    def __init__(self,pckgname,mode,compression=""):
+        PckgDefaultFile.__init__(self,pckgname,mode,compression)
+        import zipfile
+        self.pckg=zipfile.ZipFile(self.pckgname,self.mode)
+    
+    def debug(self,state=1):
+        self.debug=state
+        
+    def add(self,filename,arcname=None):
+        try:    return self.pckg.write(filename,arcname)
+        except: return -1
+
+    def extract(self,filename,path=''):
+        outfile = open(os.path.join(path,filename),"wb")
+        outfile.write(self.pckg.read(filename))
+        outfile.close()
+        return 0
+        
+    def extractall(self,path=''):
+        for name in self.pckg.namelist():
+            if self.debug: print name
+            if not name.endswith('/'):
+                directory = os.path.normpath(os.path.join(path,os.path.dirname(name)))
+                if not os.path.exists(directory): os.makedirs(directory)
+                self.extract(name,path)
+            elif not os.path.exists(name): 
+                os.makedirs(os.path.join(path,name))
+        return 0
+  
+    def read(self,filename):
+        try:    return self.pckg.read(filename)
+        except: return -1
+    
+    def check(self):
+        try:    self.pckg.namelist()
+        except: return -1            
+        return 0
+    def list(self):
+        return self.pckg.namelist()
+        
+    def getUncompressedSize(self):
+        totalSize=0
+        try:
+            for zipinfo in self.pckg.infolist():
+                totalSize+=zipinfo.file_size
+        except:
+            return-1
+        return totalSize
+        
+class PckgTarFile(PckgDefaultFile):
+    def __init__(self,pckgname,mode,compression=""):
+        PckgDefaultFile.__init__(self,pckgname,mode,compression)
+        import tarfile
+        try:
+            self.pckg=tarfile.open(self.pckgname,self.mode+":"+self.compression)
+        except Exception,e:
+            print (self.pckgname,self.mode+":"+self.compression)
+            raise e
+        
+    
+    def debug(self,state=1):
+        self.debug=state
+        self.pckg.debug=state
+           
+    def add(self,filename,arcname=None):
+        if arcname==None: arcname=filename
+        filename=link2path(filename)
+        
+        try:    self.pckg.add(filename,arcname)
+        except: return -1
+
+    def extract(self,filename,path=''):            
+        return self.pckg.extract(filename,path)
+
+    def extractall(self,path=None):
+        return self.pckg.extractall('')
+        
+    def read(self,filename):           
+        return self.pckg.extractfile(filename).read()
+
+    def check(self):
+        try:    self.pckg.getnames()
+        except: return -1
+        return 0
+    def list(self):
+        return self.pckg.getnames()   
+    def getUncompressedSize(self):
+        totalSize=0
+        try:
+            for tarinfo in self.pckg:
+                totalSize+=tarinfo.size
+        except:
+            return-1
+        return totalSize
+                
+def validExt(filename,extlist):
+    for ext in extlist:
+        if filename.endswith(ext):
+            return True
+    return False
+
+class PckgFile:
+    def __init__(self,pckgname,mode):
+        compression=''
+        if validExt(pckgname,['zip']):
+            classobj=PckgZipFile
+        elif validExt(pckgname,['tar']):
+            classobj=PckgTarFile
+        elif validExt(pckgname,['tar.gz','tgz']):
+            classobj=PckgTarFile
+            compression="gz"
+        elif validExt(pckgname,['tar.bz2']):
+            classobj=PckgTarFile
+            compression="bz2"
+        
+        self.write=self.add
+        self.pckg=classobj(pckgname,mode,compression)
+    
+    def add(self,filename,arcname=None):
+        return self.pckg.add(filename,arcname)
+    
+    def extract(self,filename,path=''):
+        return self.pckg.extract(filename,path)
+
+    def extractall(self,path=''):
+        return self.pckg.extractall(path)
+    
+    def read(self,filename):
+        return self.pckg.read(filename)
+                 
+    def close(self):
+        return self.pckg.close()
+
+    def check(self):
+        return self.pckg.check()
+    def list(self):
+        return self.pckg.list()
+        
+    def getUncompressedSize(self):
+        return self.pckg.getUncompressedSize()
+            
+                    
+#if __name__=='__main__':
+#    pckg=PckgFile("coucou2.tgz","w")
+#    for x in ['aa','aa_z.tgz']:
+#        pckg.add(x)
+#    pckg.close()
+#    
+#        
+#    #pckg=PckgFile("coucou.zip","r")
+#    ##pckg.extract(x+".bak")
+#    #pckg.extractall("extract")
+#    #pckg.close()
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/xmf_utilities.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/xmf_utilities.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/XDRpy/xmf_utilities.py	(revision 4775)
@@ -0,0 +1,225 @@
+#!/usr/bin/env python
+
+
+#######################################
+#
+# Projet Manager XMF utilities
+#
+########################################
+# This class allows to handle a cluster of h5/xmf files
+# for visualization purpose, through ensight and paraview.
+# this clas is originally used by common_visualize.py.
+#
+# Created by A. Dauptain
+#
+# Last modified : 16 septembre 2013 A Dauptain (comments)
+#                
+########################################
+
+
+import os
+from XDR import *
+
+
+class XMF_Utilities(object):
+    def __init__(self,code_id):
+        self.code = code_id
+        self.post_proc_dir = os.path.join(os.getcwd(),code_id.upper(),"SPATIAL")
+        self.filename = os.path.join(self.post_proc_dir,"c3sm_xdmfgroup.xmf")
+        
+        self.filelocation = []
+        if self.code == "avbp" :
+            self.filelocation = ["SOLUT"]
+        if self.code == "avtp" :
+            self.filelocation = ["SOLUT"]    
+
+        self.time_id_list = [0.0]
+        self.faketime = False
+        if self.code == "avsp" :
+            self.faketime = True
+        
+        
+        # cleaning
+        for f in getFileList(self.post_proc_dir,"*.xmf","relative") :
+            print "Cleaning file :",f
+            os.remove(f)
+        
+        
+    def CreateTemporaryXMFs(self,selection_files,projectLocations):
+        """ This procedure create the main XMF solution file according to
+        post_proc_dir is a string of the form AVSP, AVBP or YALES2,
+        the data will be generated in the relative path ./AVSP/SPATIAL for exemple
+        
+        selection_files is a list of  the form  [file1],[0],[file2],[1],[file3],[1],[file6],[0]
+        with files of the form "identifier # simulation # projectname # name "
+        
+        projectLocations is a dictionnary with project names as keys, and  project relative pathes as values
+        created smthg similar to:
+        projectLocations={}
+            for sc_project in getChildrenName("projects","allprojects"):
+                project_xml=getValue("sc_project","sc_project")
+                project_folder=project_xml.replace(".xml","")
+                project_name = os.path.splitext( os.path.basename(project_xml) )[0]
+                projectLocations[project_name] = project_folder
+        """
+        
+        
+        
+        
+        print "Create main XMF file "+self.filename
+        
+        xmfsolgroup = open(self.filename, 'w')
+        
+        # header
+        xmfsolgroup.write("""<?xml version="1.0" ?>
+        <!DOCTYPE Xdmf SYSTEM "Xdmf.dtd" >
+        <Xdmf xmlns:xi="http://www.w3.org/2003/XInclude" Version="2.0">
+        <Domain>
+          <Grid GridType="Collection" CollectionType="Temporal" >
+        """)
+        
+        
+        # listy ids stores the data necessary for tags in images (enspythoncut)
+        self.list_ids = []     
+         
+        for item,onoff in pairwise(selection_files) :
+            #print onoff
+            if onoff=="1" :
+                # retreive project path
+                sol_identifier = item.split('#')[0]
+                sol_simu = item.split('#')[1]
+                sol_project_name = item.split('#')[2]
+                sol_run = item.split('#')[3]
+                sol_name = item.split('#')[4]
+
+                #Check if coupling or not on AVTP or AVBP
+                addfolder=""
+                if self.code == "avtp" :
+                    cpldir = os.path.join(projectLocations[sol_project_name],sol_run,"AVTP01")
+                    cpl_avtpfile = getFileList(cpldir,"input_couple.dat")
+                    cplfile="input_couple.dat"
+                    if cplfile in cpl_avtpfile :
+                        print "we are in couple mode of AVTP"
+                        addfolder="AVTP01"
+                if self.code == "avbp" :
+                    cpldir = os.path.join(projectLocations[sol_project_name],sol_run,"AVBP01")
+                    cpl_avtpfile = getFileList(cpldir,"input_couple.dat")
+                    cplfile="input_couple.dat"
+                    if cplfile in cpl_avtpfile :
+                        print "we are in couple mode of AVBP"
+                        addfolder="AVBP01"
+                
+             
+                temporary_name = sol_project_name+"_"+sol_run+"_"+sol_name
+                sol_path =os.path.join(projectLocations[sol_project_name],sol_run,addfolder,*self.filelocation)
+                
+                time_id = self.getTimeInXMF(os.path.join(sol_path,sol_name))
+ 
+                # declaration of the file
+                xmfsolgroup.write('     <xi:include href="'+temporary_name+'" xpointer="xpointer(//Xdmf/Domain/Grid)" />\n')
+            
+                # copy of directing file
+                self.copy_XMF_file_updating_path(sol_name,sol_path,temporary_name,self.post_proc_dir,time_id)
+                
+                # solution description
+                self.list_ids.append(sol_identifier+"#"+sol_simu+"#"+sol_project_name+"#"+sol_run)
+        
+             
+        # end     
+        xmfsolgroup.write("""   </Grid>
+        </Domain>
+        </Xdmf>
+        """)
+                
+        xmfsolgroup.close()
+        
+    
+    def getTimeInXMF(self,filename):
+        """ get the time id in an XMF file """
+        
+        # search for time
+        if not os.path.exists(filename) :
+            msg =  "File "+ filename+ " Does not exists"
+            error(msg)
+        else :
+             # if time must be faken
+            if self.faketime :
+                time_id =  self.time_id_list[-1] + 1.0
+            else :
+                xmffile =  open(filename,"r")
+                lines = xmffile.readlines()
+                xmffile.close()
+                time_id = "-1"
+                for line in lines :
+                    if "Time Value=" in line :
+                        time_id = float(line.split('"')[1].strip())
+            
+                # case time is not faken, but no time foun 
+                if time_id == "-1" :
+                    msg = "No Time value stored in the file "+ filename+ ". Exiting..."
+                    error(msg)
+
+        # avoid time duplicate
+        if time_id in  self.time_id_list :
+            time_id +=  self.time_id_list[-1]/100
+            
+        self.time_id_list.append(time_id)
+        return str(time_id)
+            
+    
+    
+    def copy_XMF_file_updating_path(self,filename,location,new_filename,new_location,time_id):
+        """ create a local copy of the target file, replacing the local relative path references by absolute ones
+        time_id is written in the XMF to serve as an additionnal data
+        """    
+        
+        print "Copy "+filename+ " into"+ new_location+", updating the inner pathes"
+        
+        location = location.rstrip('/')
+        
+        initfile =  open(os.path.join(location,filename),"r")
+        lines = initfile.readlines()
+        initfile.close()
+        
+        location_m1=os.path.dirname(location)
+        location_m2=os.path.dirname(location_m1)
+        location_m3=os.path.dirname(location_m2)
+        
+        h5file = filename.replace(".xmf",".h5")
+        
+        final_lines=[]
+        # parsing document
+        for line in lines :
+            newline=line
+            
+            # time value must be given After the Grid statment
+            if "Time Value" in line:
+                newline = ''
+                
+            if "<Grid" in newline :
+                newline = '<Grid name="'+self.code.upper()+' by C3Sm">\n'+ '    <Time Value="           {0}"/>\n'.format(time_id)
+                
+                
+            if h5file in newline :
+                newline = newline.replace(h5file,os.path.join(location,h5file))
+            
+            if "../../../" in newline:
+                newline=newline.replace("../../../",location_m3+"/")
+            elif "../../" in newline:
+                newline=newline.replace("../../",location_m2+"/")
+            elif "../" in newline:
+                newline=newline.replace("../",location_m1+"/")
+            elif "./" in newline:
+                newline=newline.replace("./",location+"/")
+            final_lines.append(newline)
+        
+                  
+        newfile = open(os.path.join(new_location,new_filename), 'w')
+        newfile.writelines(final_lines)
+        newfile.close()
+    
+     
+    
+
+if __name__ == '__main__':
+    pass # Do tests
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1.xml	(revision 4775)
@@ -0,0 +1,382 @@
+<?xml version="1.0" encoding="UTF-8"?>
+    <dataset>
+        <oasis3-mct value="">
+            <param value="">
+                <intro value="" />
+                <generaldesc value="" />
+                <guidesc value="" />
+            </param>
+            <printruns value="">
+                <descprint value="" />
+                <runtime value="">
+                    <duration value="21600" />
+                </runtime>
+                <debug value="">
+                    <nlogprt value="none">
+                        <none value="" />
+                    </nlogprt>
+                </debug>
+                <timestat value="">
+                    <opttime value="none">
+                        <none value="" />
+                    </opttime>
+                </timestat>
+                <generalgroup value="">
+                    <groups_onoff value="0" />
+                    <mult_fields_name value="single" />
+                </generalgroup>
+            </printruns>
+            <modeldef value="">
+                <mainmodelparam value="" />
+                <modelparam value="">
+                    <models value="">
+                        <item_1376581 value="model1">
+                            <maxunits value="units_off">
+                                <units_off value="" />
+                            </maxunits>
+                        </item_1376581>
+                        <item_1383366 value="model2">
+                            <maxunits value="units_off">
+                                <units_off value="" />
+                            </maxunits>
+                        </item_1383366>
+                    </models>
+                    <model_names_list value="model1;model2" />
+                </modelparam>
+            </modeldef>
+            <grids value="">
+                <modelgrids value="" />
+                <defgrids value="">
+                    <gridsline value="">
+                        <item_1445319 value="torc">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="2" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="182" />
+                                    <nj_grid value="149" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1445319>
+                        <item_1462948 value="lmdz">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="0" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="96" />
+                                    <nj_grid value="72" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1462948>
+                    </gridsline>
+                    <grid_names_list value="torc;lmdz" />
+                </defgrids>
+            </grids>
+            <groups value="">
+                <groupedfld value="" />
+                <gpfld value="">
+                    <group value="" />
+                </gpfld>
+            </groups>
+            <fielddef value="">
+                <flddesc value="" />
+                <fldname value="">
+                    <flddef value="">
+                        <item_1594179 value="FSENDOCN">
+                            <namefldgui value="FSENDOCN" />
+                            <fldnamebef value="FSENDOCN" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="FRECVATM" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="single" />
+                        </item_1594179>
+                        <item_1620245 value="FSENDATM">
+                            <namefldgui value="FSENDATM" />
+                            <fldnamebef value="FSENDATM" />
+                            <srcgrid value="lmdz" />
+                            <fldnameaft value="FRECVOCN" />
+                            <tgtgrid value="torc" />
+                            <fldmult value="single" />
+                        </item_1620245>
+                        <item_1650209 value="FSENDOC2">
+                            <namefldgui value="FSENDOC2" />
+                            <fldnamebef value="FSENDOC2" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="FRECVAT2" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="single" />
+                        </item_1650209>
+                    </flddef>
+                    <field_names_list value="FSENDOCN;FSENDATM;FSENDOC2" />
+                </fldname>
+            </fielddef>
+            <cplrststatus value="">
+                <fldproper value="" />
+                <cplrststatus value="">
+                    <crs value="">
+                        <item_1770013 value="FSENDOCN">
+                            <cpl value="7200" />
+                            <restart value="rsto.nc" />
+                            <status value="exported" />
+                        </item_1770013>
+                        <item_1770024 value="FSENDATM">
+                            <cpl value="3600" />
+                            <restart value="rsta.nc" />
+                            <status value="exported" />
+                        </item_1770024>
+                        <item_1888365 value="FSENDOC2">
+                            <cpl value="3600" />
+                            <restart value="av.nc" />
+                            <status value="output" />
+                        </item_1888365>
+                    </crs>
+                </cplrststatus>
+            </cplrststatus>
+            <seqlag value="">
+                <defineseqlag value="" />
+                <defseqlag value="">
+                    <seqlag value="">
+                        <item_1510148 value="FSENDOCN">
+                            <lag value="lag_on">
+                                <lag_on value="">
+                                    <lag_fld value="3600" />
+                                </lag_on>
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1510148>
+                        <item_1510159 value="FSENDATM">
+                            <lag value="lag_on">
+                                <lag_on value="">
+                                    <lag_fld value="3600" />
+                                </lag_on>
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1510159>
+                        <item_1891028 value="FSENDOC2">
+                            <lag value="lag_off">
+                                <lag_off value="" />
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1891028>
+                    </seqlag>
+                </defseqlag>
+            </seqlag>
+            <timetransfo value="">
+                <timetransfo value="" />
+                <transftime value="">
+                    <time value="">
+                        <item_1530650 value="FSENDOCN">
+                            <loctrans value="loctrans_on">
+                                <loctrans_on value="">
+                                    <loctransdef value="average" />
+                                </loctrans_on>
+                            </loctrans>
+                        </item_1530650>
+                        <item_1530661 value="FSENDATM">
+                            <loctrans value="loctrans_on">
+                                <loctrans_on value="">
+                                    <loctransdef value="accumul" />
+                                </loctrans_on>
+                            </loctrans>
+                        </item_1530661>
+                        <item_1894996 value="FSENDOC2">
+                            <loctrans value="loctrans_on">
+                                <loctrans_on value="">
+                                    <loctransdef value="accumul" />
+                                </loctrans_on>
+                            </loctrans>
+                        </item_1894996>
+                    </time>
+                </transftime>
+            </timetransfo>
+            <checktransfo value="">
+                <cicotransfo value="" />
+                <transfcico value="">
+                    <checkinoutminmax value="">
+                        <item_1534445 value="FSENDOCN">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1534445>
+                        <item_1534456 value="FSENDATM">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1534456>
+                        <item_1897132 value="FSENDOC2">
+                            <checkin value="checkin_off">
+                                <checkin_off value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1897132>
+                    </checkinoutminmax>
+                </transfcico>
+            </checktransfo>
+            <blastransfo value="">
+                <transfblas value="" />
+                <transfblon value="">
+                    <multaddoldnew value="">
+                        <item_1558897 value="FSENDOCN">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_1558897>
+                        <item_1558908 value="FSENDATM">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_1558908>
+                        <item_1900787 value="FSENDOC2">
+                            <blasold value="blasold_on">
+                                <blasold_on value="">
+                                    <xmult_blso value="1." />
+                                    <xadd_blso value="3" />
+                                </blasold_on>
+                            </blasold>
+                            <blasnew value="blasnew_on">
+                                <blasnew_on value="">
+                                    <xmult_blsn value="10" />
+                                    <xadd_blsn value="1." />
+                                </blasnew_on>
+                            </blasnew>
+                        </item_1900787>
+                    </multaddoldnew>
+                </transfblon>
+            </blastransfo>
+            <interpolation value="">
+                <scriptransfo value="" />
+                <transfinterp value="">
+                    <interp value="">
+                        <item_1565614 value="FSENDOCN">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_1565614>
+                        <item_1565625 value="FSENDATM">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_1565625>
+                        <item_1904442 value="FSENDOC2">
+                            <scrip value="scrip_on">
+                                <scrip_on value="">
+                                    <scriprinterp value="bilinear">
+                                        <bilinear value="">
+                                            <cgrs_bili value="lr_bili" />
+                                            <rest_bili value="latlon_bili" />
+                                            <nbin_bili value="1" />
+                                        </bilinear>
+                                    </scriprinterp>
+                                </scrip_on>
+                            </scrip>
+                        </item_1904442>
+                    </interp>
+                </transfinterp>
+            </interpolation>
+            <mapping value="">
+                <mappingtransfo value="" />
+                <transfmap value="">
+                    <map value="">
+                        <item_1587037 value="FSENDOCN">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="map1.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_1587037>
+                        <item_1587048 value="FSENDATM">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="map2.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_1587048>
+                        <item_1906578 value="FSENDOC2">
+                            <mapremapping value="mapping_off">
+                                <mapping_off value="" />
+                            </mapremapping>
+                        </item_1906578>
+                    </map>
+                </transfmap>
+            </mapping>
+            <conservtransof value="">
+                <conservtransfo value="" />
+                <transfconserv value="">
+                    <conservation value="">
+                        <item_1606394 value="FSENDOCN">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1606394>
+                        <item_1606405 value="FSENDATM">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1606405>
+                        <item_1908714 value="FSENDOC2">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1908714>
+                    </conservation>
+                </transfconserv>
+            </conservtransof>
+            <summary value="">
+                <scriptsummary value="">
+                    <summaryscript value="******************************************************************BREAKLINE*** Summary of the coupling fields and their transformations: BREAKLINE******************************************************************BREAKLINE******************************************************************BREAKLINEFSENDOCN-FRECVATM:BREAKLINESource grid : torcBREAKLINEDimensions : 182x149BREAKLINETarget grid : lmdzBREAKLINEDimensions : 96x72BREAKLINESource grid periodical with  2 overlapping pointsBREAKLINETarget grid periodical with  0 overlapping points BREAKLINECoupling period=7200BREAKLINERestart file: rsto.ncBREAKLINEField status: EXPORTEDBREAKLINE LAG=3600BREAKLINETime transformation:AVERAGEBREAKLINEMin and max of the field sent calculatedBREAKLINEMin and max of the received field calculatedBREAKLINEMAPPING is used with options: src and bfbBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEFSENDATM-FRECVOCN:BREAKLINESource grid : lmdzBREAKLINEDimensions : 96x72BREAKLINETarget grid : torcBREAKLINEDimensions : 182x149BREAKLINESource grid periodical with  0 overlapping pointsBREAKLINETarget grid periodical with  2 overlapping points BREAKLINECoupling period=3600BREAKLINERestart file: rsta.ncBREAKLINEField status: EXPORTEDBREAKLINE LAG=3600BREAKLINETime transformation:ACCUMULBREAKLINEMin and max of the field sent calculatedBREAKLINEMin and max of the received field calculatedBREAKLINEMAPPING is used with options: src and bfbBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEFSENDOC2-FSENDOC2:BREAKLINESource grid : torcBREAKLINEDimensions : 182x149BREAKLINETarget grid : lmdzBREAKLINEDimensions : 96x72BREAKLINESource grid periodical with  2 overlapping pointsBREAKLINETarget grid periodical with  0 overlapping points BREAKLINECoupling period=3600BREAKLINERestart file: av.ncBREAKLINEField status: OUTPUTBREAKLINEBREAKLINETime transformation:ACCUMULBREAKLINEMin and max of the received field calculatedBREAKLINEMultiply by 1. the field sentBREAKLINEAdd 3 to the field sentBREAKLINEMultiply by 10 the received fieldBREAKLINEAdd 1. to the received fieldBREAKLINESCRIPR is used: BREAKLINEBILINEAR interpolationBREAKLINE********************************************************BREAKLINE********************************************************" />
+                </scriptsummary>
+            </summary>
+            <write value="">
+                <scriptnamcouple value="">
+                    <namcouplescript value="$NFIELDS BREAKLINE3BREAKLINE$END BREAKLINE####BREAKLINE$NBMODEL BREAKLINE2 model1 model2BREAKLINE$END BREAKLINE####BREAKLINE$RUNTIME BREAKLINE21600BREAKLINE$END BREAKLINE####BREAKLINE$NLOGPRT BREAKLINE0 0BREAKLINE$END BREAKLINE####BREAKLINE$STRINGS BREAKLINEFSENDOCN FRECVATM 1 7200 4 rsto.nc EXPORTEDBREAKLINE182 149 96 72 torc lmdz LAG=3600BREAKLINEP 2 P 0 BREAKLINELOCTRANS CHECKIN MAPPING CHECKOUT BREAKLINEAVERAGE BREAKLINEINT=1BREAKLINEmap1.nc src bfb BREAKLINEINT=1BREAKLINE####BREAKLINEFSENDATM FRECVOCN 1 3600 4 rsta.nc EXPORTEDBREAKLINE96 72 182 149 lmdz torc LAG=3600BREAKLINEP 0 P 2 BREAKLINELOCTRANS CHECKIN MAPPING CHECKOUT BREAKLINEACCUMUL BREAKLINEINT=1BREAKLINEmap2.nc src bfb BREAKLINEINT=1BREAKLINE####BREAKLINEFSENDOC2 FSENDOC2 1 3600 1 av.nc OUTPUTBREAKLINEtorc torcBREAKLINELOCTRANSBREAKLINEACCUMUL BREAKLINE####BREAKLINE $END" />
+                </scriptnamcouple>
+            </write>
+        </oasis3-mct>
+        <meta>
+            <solver>
+                <name value="oasis3-mct" />
+            </solver>
+            <project>
+                <name value="test1" />
+                <address value="/home/evian/coquart/OASIS/OASISGUI/examples_xml_namcouple/test1.xml" />
+                <username value="myName" />
+                <company value="myCompany" />
+            </project>
+            <action>
+                <callingAddress value="root.oasis3-mct.write" />
+            </action>
+            <temporary />
+            <scriptSuccess value="1" />
+            <engine>
+                <name value="OpenTEA" />
+                <launchCommand value="/usr/bin/wish /home/evian/coquart/OASIS/OASISGUI/opentea/opentea.tcl  -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -library /home/evian/coquart/OASIS/OASISGUI/library -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -plugins /home/evian/coquart/OASIS/OASISGUI/library/DATA/pluginscripts" />
+                <pluginsPath value="/home/evian/coquart/OASIS/OASISGUI/library/DATA/pluginscripts" />
+                <libraryPath value="/home/evian/coquart/OASIS/OASISGUI/library" />
+                <configPath value="/home/evian/coquart/OASIS/OASISGUI/myconfig.xml" />
+            </engine>
+        </meta>
+    </dataset>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1/namcouple
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1/namcouple	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test1/namcouple	(revision 4775)
@@ -0,0 +1,49 @@
+# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################
+ $NFIELDS 
+3
+ $END
+############################################
+ $NBMODEL 
+2 model1 model2
+ $END
+############################################
+ $RUNTIME 
+21600
+ $END
+############################################
+ $NLOGPRT 
+0 0
+ $END
+############################################
+ $STRINGS 
+FSENDOCN FRECVATM 1 7200 4 rsto.nc EXPORTED
+182 149 96 72 torc lmdz LAG=3600
+P 2 P 0 
+LOCTRANS CHECKIN MAPPING CHECKOUT 
+AVERAGE 
+INT=1
+map1.nc src bfb 
+INT=1
+####
+FSENDATM FRECVOCN 1 3600 4 rsta.nc EXPORTED
+96 72 182 149 lmdz torc LAG=3600
+P 0 P 2 
+LOCTRANS CHECKIN MAPPING CHECKOUT 
+ACCUMUL 
+INT=1
+map2.nc src bfb 
+INT=1
+####
+FSENDOC2 FSENDOC2 1 3600 1 av.nc OUTPUT
+torc torc
+LOCTRANS
+ACCUMUL 
+####
+ $END
+############################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2.xml	(revision 4775)
@@ -0,0 +1,521 @@
+<?xml version="1.0" encoding="UTF-8"?>
+    <dataset>
+        <oasis3-mct value="">
+            <param value="">
+                <intro value="" />
+                <generaldesc value="" />
+                <guidesc value="" />
+            </param>
+            <printruns value="">
+                <descprint value="" />
+                <runtime value="">
+                    <duration value="21600" />
+                </runtime>
+                <debug value="">
+                    <nlogprt value="none">
+                        <none value="" />
+                    </nlogprt>
+                </debug>
+                <timestat value="">
+                    <opttime value="none">
+                        <none value="" />
+                    </opttime>
+                </timestat>
+                <generalgroup value="">
+                    <groups_onoff value="1" />
+                    <mult_fields_name value="single;INPUTGROUP;INPUTG2" />
+                </generalgroup>
+            </printruns>
+            <modeldef value="">
+                <mainmodelparam value="" />
+                <modelparam value="">
+                    <models value="">
+                        <item_1376581 value="model1">
+                            <maxunits value="units_off">
+                                <units_off value="" />
+                            </maxunits>
+                        </item_1376581>
+                        <item_1383366 value="model2">
+                            <maxunits value="units_off">
+                                <units_off value="" />
+                            </maxunits>
+                        </item_1383366>
+                    </models>
+                    <model_names_list value="model1;model2" />
+                </modelparam>
+            </modeldef>
+            <grids value="">
+                <modelgrids value="" />
+                <defgrids value="">
+                    <gridsline value="">
+                        <item_1445319 value="torc">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="2" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="182" />
+                                    <nj_grid value="149" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1445319>
+                        <item_1462948 value="lmdz">
+                            <gridstatus value="periodical_grid" />
+                            <grid_overlap value="0" />
+                            <dimsgrid value="dims_on">
+                                <dims_on value="">
+                                    <ni_grid value="96" />
+                                    <nj_grid value="72" />
+                                </dims_on>
+                            </dimsgrid>
+                        </item_1462948>
+                    </gridsline>
+                    <grid_names_list value="torc;lmdz" />
+                </defgrids>
+            </grids>
+            <groups value="">
+                <groupedfld value="" />
+                <gpfld value="">
+                    <group value="">
+                        <item_1734452 value="INPUTGROUP">
+                            <group_comment value="Fields read from a file" />
+                        </item_1734452>
+                        <item_7020836 value="INPUTG2">
+                            <group_comment value="" />
+                        </item_7020836>
+                    </group>
+                </gpfld>
+            </groups>
+            <fielddef value="">
+                <flddesc value="" />
+                <fldname value="">
+                    <flddef value="">
+                        <item_1594179 value="FSENDOCN">
+                            <namefldgui value="FSENDOCN" />
+                            <fldnamebef value="FSENDOCN" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="FRECVATM" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="single" />
+                        </item_1594179>
+                        <item_1620245 value="FSENDATM">
+                            <namefldgui value="FSENDATM" />
+                            <fldnamebef value="FSENDATM" />
+                            <srcgrid value="lmdz" />
+                            <fldnameaft value="FRECVOCN" />
+                            <tgtgrid value="torc" />
+                            <fldmult value="single" />
+                        </item_1620245>
+                        <item_1650209 value="FSENDOC2">
+                            <namefldgui value="FSENDOC2" />
+                            <fldnamebef value="FSENDOC2" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="FRECVAT2" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="single" />
+                        </item_1650209>
+                        <item_2253601 value="INPUTAT1">
+                            <namefldgui value="INPUTGROUP" />
+                            <fldnamebef value="INPUTAT1" />
+                            <srcgrid value="lmdz" />
+                            <fldnameaft value="RECVAT1" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="INPUTGROUP" />
+                        </item_2253601>
+                        <item_2641752 value="INPUTAT2">
+                            <namefldgui value="INPUTGROUP" />
+                            <fldnamebef value="INPUTAT2" />
+                            <srcgrid value="lmdz" />
+                            <fldnameaft value="RECVAT2" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="INPUTGROUP" />
+                        </item_2641752>
+                        <item_2668314 value="INPUTAT3">
+                            <namefldgui value="INPUTGROUP" />
+                            <fldnamebef value="INPUTAT3" />
+                            <srcgrid value="lmdz" />
+                            <fldnameaft value="RECVAT3" />
+                            <tgtgrid value="lmdz" />
+                            <fldmult value="INPUTGROUP" />
+                        </item_2668314>
+                        <item_7338235 value="INPUTOCN">
+                            <namefldgui value="INPUTOCN" />
+                            <fldnamebef value="INPUTOCN" />
+                            <srcgrid value="torc" />
+                            <fldnameaft value="INPUTOC1" />
+                            <tgtgrid value="torc" />
+                            <fldmult value="single" />
+                        </item_7338235>
+                    </flddef>
+                    <field_names_list value="FSENDOCN;FSENDATM;FSENDOC2;INPUTGROUP;INPUTOCN" />
+                </fldname>
+            </fielddef>
+            <cplrststatus value="">
+                <fldproper value="" />
+                <cplrststatus value="">
+                    <crs value="">
+                        <item_1770013 value="FSENDOCN">
+                            <cpl value="7200" />
+                            <restart value="rsto.nc" />
+                            <status value="exported" />
+                        </item_1770013>
+                        <item_1770024 value="FSENDATM">
+                            <cpl value="3600" />
+                            <restart value="rsta.nc" />
+                            <status value="exported" />
+                        </item_1770024>
+                        <item_1888365 value="FSENDOC2">
+                            <cpl value="3600" />
+                            <restart value="av.nc" />
+                            <status value="output" />
+                        </item_1888365>
+                        <item_2608836 value="INPUTGROUP">
+                            <cpl value="7200" />
+                            <restart value="av2.nc" />
+                            <status value="input" />
+                        </item_2608836>
+                        <item_9265585 value="INPUTOCN">
+                            <cpl value="3600" />
+                            <restart value="av3.nc" />
+                            <status value="input" />
+                        </item_9265585>
+                    </crs>
+                </cplrststatus>
+            </cplrststatus>
+            <seqlag value="">
+                <defineseqlag value="" />
+                <defseqlag value="">
+                    <seqlag value="">
+                        <item_1510148 value="FSENDOCN">
+                            <lag value="lag_on">
+                                <lag_on value="">
+                                    <lag_fld value="3600" />
+                                </lag_on>
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1510148>
+                        <item_1510159 value="FSENDATM">
+                            <lag value="lag_on">
+                                <lag_on value="">
+                                    <lag_fld value="3600" />
+                                </lag_on>
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1510159>
+                        <item_1891028 value="FSENDOC2">
+                            <lag value="lag_off">
+                                <lag_off value="" />
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_1891028>
+                        <item_2611612 value="INPUTGROUP">
+                            <lag value="lag_off">
+                                <lag_off value="" />
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_2611612>
+                        <item_9268698 value="INPUTOCN">
+                            <lag value="lag_off">
+                                <lag_off value="" />
+                            </lag>
+                            <seq value="seq_off">
+                                <seq_off value="" />
+                            </seq>
+                        </item_9268698>
+                    </seqlag>
+                </defseqlag>
+            </seqlag>
+            <timetransfo value="">
+                <timetransfo value="" />
+                <transftime value="">
+                    <time value="">
+                        <item_1530650 value="FSENDOCN">
+                            <loctrans value="loctrans_on">
+                                <loctrans_on value="">
+                                    <loctransdef value="average" />
+                                </loctrans_on>
+                            </loctrans>
+                        </item_1530650>
+                        <item_1530661 value="FSENDATM">
+                            <loctrans value="loctrans_on">
+                                <loctrans_on value="">
+                                    <loctransdef value="accumul" />
+                                </loctrans_on>
+                            </loctrans>
+                        </item_1530661>
+                        <item_1894996 value="FSENDOC2">
+                            <loctrans value="loctrans_off">
+                                <loctrans_off value="" />
+                            </loctrans>
+                        </item_1894996>
+                        <item_2615730 value="INPUTGROUP">
+                            <loctrans value="loctrans_off">
+                                <loctrans_off value="" />
+                            </loctrans>
+                        </item_2615730>
+                        <item_9273226 value="INPUTOCN">
+                            <loctrans value="loctrans_off">
+                                <loctrans_off value="" />
+                            </loctrans>
+                        </item_9273226>
+                    </time>
+                </transftime>
+            </timetransfo>
+            <checktransfo value="">
+                <cicotransfo value="" />
+                <transfcico value="">
+                    <checkinoutminmax value="">
+                        <item_1534445 value="FSENDOCN">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1534445>
+                        <item_1534456 value="FSENDATM">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1534456>
+                        <item_1897132 value="FSENDOC2">
+                            <checkin value="checkin_off">
+                                <checkin_off value="" />
+                            </checkin>
+                            <checkout value="checkout_on">
+                                <checkout_on value="" />
+                            </checkout>
+                        </item_1897132>
+                        <item_2617961 value="INPUTGROUP">
+                            <checkin value="checkin_on">
+                                <checkin_on value="" />
+                            </checkin>
+                            <checkout value="checkout_off">
+                                <checkout_off value="" />
+                            </checkout>
+                        </item_2617961>
+                        <item_9275716 value="INPUTOCN">
+                            <checkin value="checkin_off">
+                                <checkin_off value="" />
+                            </checkin>
+                            <checkout value="checkout_off">
+                                <checkout_off value="" />
+                            </checkout>
+                        </item_9275716>
+                    </checkinoutminmax>
+                </transfcico>
+            </checktransfo>
+            <blastransfo value="">
+                <transfblas value="" />
+                <transfblon value="">
+                    <multaddoldnew value="">
+                        <item_1558897 value="FSENDOCN">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_1558897>
+                        <item_1558908 value="FSENDATM">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_1558908>
+                        <item_1900787 value="FSENDOC2">
+                            <blasold value="blasold_on">
+                                <blasold_on value="">
+                                    <xmult_blso value="1." />
+                                    <xadd_blso value="3" />
+                                </blasold_on>
+                            </blasold>
+                            <blasnew value="blasnew_on">
+                                <blasnew_on value="">
+                                    <xmult_blsn value="10" />
+                                    <xadd_blsn value="1." />
+                                </blasnew_on>
+                            </blasnew>
+                        </item_1900787>
+                        <item_2621766 value="INPUTGROUP">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_2621766>
+                        <item_9279929 value="INPUTOCN">
+                            <blasold value="blasold_off">
+                                <blasold_off value="" />
+                            </blasold>
+                            <blasnew value="blasnew_off">
+                                <blasnew_off value="" />
+                            </blasnew>
+                        </item_9279929>
+                    </multaddoldnew>
+                </transfblon>
+            </blastransfo>
+            <interpolation value="">
+                <scriptransfo value="" />
+                <transfinterp value="">
+                    <interp value="">
+                        <item_1565614 value="FSENDOCN">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_1565614>
+                        <item_1565625 value="FSENDATM">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_1565625>
+                        <item_1904442 value="FSENDOC2">
+                            <scrip value="scrip_on">
+                                <scrip_on value="">
+                                    <scriprinterp value="bilinear">
+                                        <bilinear value="">
+                                            <cgrs_bili value="lr_bili" />
+                                            <rest_bili value="latlon_bili" />
+                                            <nbin_bili value="1" />
+                                        </bilinear>
+                                    </scriprinterp>
+                                </scrip_on>
+                            </scrip>
+                        </item_1904442>
+                        <item_2625571 value="INPUTGROUP">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_2625571>
+                        <item_9284132 value="INPUTOCN">
+                            <scrip value="scrip_off">
+                                <scrip_off value="" />
+                            </scrip>
+                        </item_9284132>
+                    </interp>
+                </transfinterp>
+            </interpolation>
+            <mapping value="">
+                <mappingtransfo value="" />
+                <transfmap value="">
+                    <map value="">
+                        <item_1587037 value="FSENDOCN">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="map1.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_1587037>
+                        <item_1587048 value="FSENDATM">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="map2.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_1587048>
+                        <item_1906578 value="FSENDOC2">
+                            <mapremapping value="mapping_off">
+                                <mapping_off value="" />
+                            </mapremapping>
+                        </item_1906578>
+                        <item_2627802 value="INPUTGROUP">
+                            <mapremapping value="mapping_on">
+                                <mapping_on value="">
+                                    <filename value="myf3.nc" />
+                                    <maploc value="src" />
+                                    <mapstrategy value="bfb" />
+                                </mapping_on>
+                            </mapremapping>
+                        </item_2627802>
+                        <item_9286622 value="INPUTOCN">
+                            <mapremapping value="mapping_off">
+                                <mapping_off value="" />
+                            </mapremapping>
+                        </item_9286622>
+                    </map>
+                </transfmap>
+            </mapping>
+            <conservtransof value="">
+                <conservtransfo value="" />
+                <transfconserv value="">
+                    <conservation value="">
+                        <item_1606394 value="FSENDOCN">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1606394>
+                        <item_1606405 value="FSENDATM">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1606405>
+                        <item_1908714 value="FSENDOC2">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_1908714>
+                        <item_2630033 value="INPUTGROUP">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_2630033>
+                        <item_9289118 value="INPUTOCN">
+                            <conservopt value="conserv_off">
+                                <conserv_off value="" />
+                            </conservopt>
+                        </item_9289118>
+                    </conservation>
+                </transfconserv>
+            </conservtransof>
+            <summary value="">
+                <scriptsummary value="">
+                    <summaryscript value="******************************************************************BREAKLINE*** Summary of the coupling fields and their transformations: BREAKLINE******************************************************************BREAKLINE******************************************************************BREAKLINEFSENDOCN-FRECVATM:BREAKLINESource grid : torcBREAKLINEDimensions : 182x149BREAKLINETarget grid : lmdzBREAKLINEDimensions : 96x72BREAKLINESource grid periodical with  2 overlapping pointsBREAKLINETarget grid periodical with  0 overlapping points BREAKLINECoupling period=7200BREAKLINERestart file: rsto.ncBREAKLINEField status: EXPORTEDBREAKLINE LAG=3600BREAKLINETime transformation:AVERAGEBREAKLINEMin and max of the field sent calculatedBREAKLINEMin and max of the received field calculatedBREAKLINEMAPPING is used with options: src and bfbBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEFSENDATM-FRECVOCN:BREAKLINESource grid : lmdzBREAKLINEDimensions : 96x72BREAKLINETarget grid : torcBREAKLINEDimensions : 182x149BREAKLINESource grid periodical with  0 overlapping pointsBREAKLINETarget grid periodical with  2 overlapping points BREAKLINECoupling period=3600BREAKLINERestart file: rsta.ncBREAKLINEField status: EXPORTEDBREAKLINE LAG=3600BREAKLINETime transformation:ACCUMULBREAKLINEMin and max of the field sent calculatedBREAKLINEMin and max of the received field calculatedBREAKLINEMAPPING is used with options: src and bfbBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEFSENDOC2-FSENDOC2:BREAKLINESource grid : torcBREAKLINEDimensions : 182x149BREAKLINETarget grid : lmdzBREAKLINEDimensions : 96x72BREAKLINESource grid periodical with  2 overlapping pointsBREAKLINETarget grid periodical with  0 overlapping points BREAKLINECoupling period=3600BREAKLINERestart file: av.ncBREAKLINEField status: OUTPUTBREAKLINEBREAKLINEMin and max of the received field calculatedBREAKLINEMultiply by 1. the field sentBREAKLINEAdd 3 to the field sentBREAKLINEMultiply by 10 the received fieldBREAKLINEAdd 1. to the received fieldBREAKLINESCRIPR is used: BREAKLINEBILINEAR interpolationBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEINPUTAT1:INPUTAT2:INPUTAT3-INPUTAT1:INPUTAT2:INPUTAT3BREAKLINESource grid : lmdzBREAKLINEDimensions : 96x72BREAKLINETarget grid : lmdzBREAKLINEDimensions : 96x72BREAKLINESource grid periodical with  0 overlapping pointsBREAKLINETarget grid periodical with  0 overlapping points BREAKLINECoupling period=7200BREAKLINERestart file: av2.ncBREAKLINEField status: INPUTBREAKLINEBREAKLINEMin and max of the field sent calculatedBREAKLINEMAPPING is used with options: src and bfbBREAKLINE********************************************************BREAKLINE********************************************************BREAKLINEINPUTOCN-INPUTOCN:BREAKLINESource grid : torcBREAKLINEDimensions : 182x149BREAKLINETarget grid : torcBREAKLINEDimensions : 182x149BREAKLINESource grid periodical with  2 overlapping pointsBREAKLINETarget grid periodical with  2 overlapping points BREAKLINECoupling period=3600BREAKLINERestart file: av3.ncBREAKLINEField status: INPUTBREAKLINEBREAKLINE********************************************************BREAKLINE********************************************************" />
+                </scriptsummary>
+            </summary>
+            <write value="">
+                <scriptnamcouple value="">
+                    <namcouplescript value="$NFIELDS BREAKLINE7BREAKLINE$END BREAKLINE####BREAKLINE$NBMODEL BREAKLINE2 model1 model2BREAKLINE$END BREAKLINE####BREAKLINE$RUNTIME BREAKLINE21600BREAKLINE$END BREAKLINE####BREAKLINE$NLOGPRT BREAKLINE0 0BREAKLINE$END BREAKLINE####BREAKLINE$STRINGS BREAKLINEFSENDOCN FRECVATM 1 7200 4 rsto.nc EXPORTEDBREAKLINE182 149 96 72 torc lmdz LAG=3600BREAKLINEP 2 P 0 BREAKLINELOCTRANS CHECKIN MAPPING CHECKOUT BREAKLINEAVERAGE BREAKLINEINT=1BREAKLINEmap1.nc src bfb BREAKLINEINT=1BREAKLINE####BREAKLINEFSENDATM FRECVOCN 1 3600 4 rsta.nc EXPORTEDBREAKLINE96 72 182 149 lmdz torc LAG=3600BREAKLINEP 0 P 2 BREAKLINELOCTRANS CHECKIN MAPPING CHECKOUT BREAKLINEACCUMUL BREAKLINEINT=1BREAKLINEmap2.nc src bfb BREAKLINEINT=1BREAKLINE####BREAKLINEFSENDOC2 FSENDOC2 1 3600 0 av.nc OUTPUTBREAKLINEtorc torcBREAKLINE####BREAKLINEINPUTAT1:INPUTAT2:INPUTAT3 RECVAT1:RECVAT2:RECVAT3 1 7200 0 av2.nc INPUTBREAKLINE####BREAKLINEINPUTOCN INPUTOCN 1 3600 0 av3.nc INPUTBREAKLINE####BREAKLINE $END" />
+                </scriptnamcouple>
+            </write>
+        </oasis3-mct>
+        <meta>
+            <solver>
+                <name value="oasis3-mct" />
+            </solver>
+            <project>
+                <name value="test2" />
+                <address value="/home/evian/coquart/OASIS/OASISGUI/examples_xml_namcouple/test2.xml" />
+                <username value="myName" />
+                <company value="myCompany" />
+            </project>
+            <action>
+                <callingAddress value="root.oasis3-mct.write" />
+            </action>
+            <temporary />
+            <scriptSuccess value="1" />
+            <engine>
+                <name value="OpenTEA" />
+                <launchCommand value="/usr/bin/wish /home/evian/coquart/OASIS/OASISGUI/opentea/opentea.tcl  -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -library /home/evian/coquart/OASIS/OASISGUI/library -config /home/evian/coquart/OASIS/OASISGUI/myconfig.xml -plugins /home/evian/coquart/OASIS/OASISGUI/library/DATA/pluginscripts" />
+                <pluginsPath value="/home/evian/coquart/OASIS/OASISGUI/library/DATA/pluginscripts" />
+                <libraryPath value="/home/evian/coquart/OASIS/OASISGUI/library" />
+                <configPath value="/home/evian/coquart/OASIS/OASISGUI/myconfig.xml" />
+            </engine>
+        </meta>
+    </dataset>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2/namcouple
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2/namcouple	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/examples_xml_namcouple/test2/namcouple	(revision 4775)
@@ -0,0 +1,51 @@
+# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################
+ $NFIELDS 
+7
+ $END
+############################################
+ $NBMODEL 
+2 model1 model2
+ $END
+############################################
+ $RUNTIME 
+21600
+ $END
+############################################
+ $NLOGPRT 
+0 0
+ $END
+############################################
+ $STRINGS 
+FSENDOCN FRECVATM 1 7200 4 rsto.nc EXPORTED
+182 149 96 72 torc lmdz LAG=3600
+P 2 P 0 
+LOCTRANS CHECKIN MAPPING CHECKOUT 
+AVERAGE 
+INT=1
+map1.nc src bfb 
+INT=1
+####
+FSENDATM FRECVOCN 1 3600 4 rsta.nc EXPORTED
+96 72 182 149 lmdz torc LAG=3600
+P 0 P 2 
+LOCTRANS CHECKIN MAPPING CHECKOUT 
+ACCUMUL 
+INT=1
+map2.nc src bfb 
+INT=1
+####
+FSENDOC2 FSENDOC2 1 3600 0 av.nc OUTPUT
+torc torc
+####
+INPUTAT1:INPUTAT2:INPUTAT3 RECVAT1:RECVAT2:RECVAT3 1 7200 0 av2.nc INPUT
+####
+INPUTOCN INPUTOCN 1 3600 0 av3.nc INPUT
+####
+ $END
+############################################
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/gittag
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/gittag	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/gittag	(revision 4775)
@@ -0,0 +1,8 @@
+Development version
+user:  dauptain
+V_1.1-45-gde1c83b
+commit de1c83b9dd58ea318501dd216f8d97360002e511
+Author: Antoine Dauptain <dauptain@yg.cerfacs.fr>
+Date:   Wed Aug 27 16:44:24 2014 +0200
+
+master
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/.species.c3s
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/.species.c3s	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/.species.c3s	(revision 4775)
@@ -0,0 +1,19 @@
+<dataset name="atoms" title="Atoms">
+	<item name="o" weight="15.9994" colorrgb="0. 0. 255."/>
+	<item name="c" weight="12.0107" colorrgb="255. 0. 0."/>
+	<item name="h" weight="1.00794" colorrgb="0. 255. 0."/>
+	<item name="n" weight="14.00674" colorrgb="255. 255. 255."/>
+</dataset>
+
+<dataset name="species" title="Physical species">
+	<item name="o2" natom_o="2." natom_c="0." natom_h="0." natom_n="0." hform0k="0."/> 
+	<item name="n2" natom_o="0." natom_c="0." natom_h="0." natom_n="2." hform0k="0."/> 
+	<item name="h2" natom_o="0." natom_c="0." natom_h="2." natom_n="0." hform0k="0."/> 
+	<item name="ch4" natom_o="0." natom_c="1." natom_h="4." natom_n="0." hform0k="-4675."/>
+	<item name="c2h6" natom_o="0." natom_c="2." natom_h="6." natom_n="0." hform0k="-4675."/> 
+	<item name="c8h18" natom_o="0." natom_c="8." natom_h="18." natom_n="0." hform0k="-1829."/> 
+	<item name="co2" natom_o="2." natom_c="1." natom_h="0." natom_n="0." hform0k="-8943."/> 
+	<item name="h2o" natom_o="1." natom_c="0." natom_h="2." natom_n="0." hform0k="-13435."/>
+	<item name="kero_luche" natom_o="0." natom_c="10." natom_h="22." natom_n="0." hform0k="-13435."/> 
+	<item name="air" natom_o="2." natom_c="0." natom_h="0." natom_n="8" hform0k="-13435." />
+</dataset>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/avtp_db.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/avtp_db.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/avtp_db.xml	(revision 4775)
@@ -0,0 +1,80 @@
+<model layout="flat" name="avtp_db" version="25.02.13">
+  <xor default="astm310" groups="on" name="materials">
+    <model name="astm310">
+      <info default="astm310" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="plexiglas">
+      <info default="plexiglas" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="z12cns25">
+      <info default="z12cns25" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="nimonic75">
+      <info default="nimonic75" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="fer">
+      <info default="fer" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="fer_varie">
+      <info default="fer_varie" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="qpf_cpl">
+      <info default="qpf_cpl" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="nc20t">
+      <info default="nc20t" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="ceramic">
+      <info default="ceramic" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="z10cnt18-11">
+      <info default="z10cnt18-11" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="z25cnws22">
+      <info default="z25cnws22" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="inconel718">
+      <info default="inconel718" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="inconel738">
+      <info default="inconel738" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="kcn22w">
+      <info default="kcn22w" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="nc22dnb">
+      <info default="nc22dnb" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="nc22fed">
+      <info default="nc22fed" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="cuco02">
+      <info default="cuco02" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="cuco02_1">
+      <info default="cuco02_1" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+    <model name="t800">
+      <info default="t800" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.0d0" name="adnum_species" type="string" visibility="hidden"/>
+    </model>
+  </xor>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/bdd.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/bdd.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/bdd.xml	(revision 4775)
@@ -0,0 +1,781 @@
+<?xml version="1.0" ?>
+<model layout="flat" name="avbp_db" version="27.05.14">
+  <xor default="air" groups="on" name="mixtures">
+    <model name="air" title="AIR">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="air" name="species_name" type="string" visibility="hidden"/>
+      <info default="1.d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="sutherland" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.716d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="273.15d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="110.6d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.71d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=hmg;caption=Homogenerous equivalent compound- no reactions][] Species : AIR[]</desc>
+    </model>
+    <model name="ch4-air-2s-cm2_premix" title="CH4 AIR 2steps CM2 PREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="air" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.677d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=hmg;caption=Homogenerous equivalent compound- no reactions][] Species : AIR[]</desc>
+    </model>
+    <model name="ch4-air-2s-cm2_nonpremix" title="CH4 AIR 2steps CM2 NONPREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="ch4;o2;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.677d0;0.739d0;0.726d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=mspec;caption=Multispecies - no reactions][] Species : CH4 O2 N2[]</desc>
+    </model>
+    <model name="ch4-air-2s-cm2_flammable" title="CH4 AIR 2steps CM2 FLAMMABLE">
+      <model layout="flat" name="reactions">
+        <model layout="flat" name="ch4-air-2s-cm2-1">
+          <info default="4" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="ch4;o2;co;h2o" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-1.5d0;1.d0;2.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="0.9d0;1.1d0;0.d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;0.d0;0.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="2.0d15" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="35000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+        </model>
+        <model layout="flat" name="ch4-air-2s-cm2-2">
+          <info default="3" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="co;o2;co2" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-0.5d0;1.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="1.d0;0.5d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;1.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="-2.0d9" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="12000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+        </model>
+      </model>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="reduced" name="chemistry" type="string" visibility="hidden"/>
+      <info default="ch4;co2;co;o2;h2o;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.677d0;0.945d0;0.750d0;0.739d0;0.544d0;0.726d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="1d0;0d0;0d0;0d0;0d0;0d0" name="species_fuel_tank" type="string" visibility="hidden"/>
+      <info default="0d0;0d0;0d0;0.233d0;0d0;0.767d0" name="species_oxy_tank" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=flammable;caption=Multispecies - flammable][] Species : CH4 CO2 CO O2 H2O N2[]Chemistry : reduced[][]===== REACTIONS =====[] ch4 + 1.5 o2 -} co + 2 h2o  [] co + 0.5 o2 {-} co2  []</desc>
+    </model>
+    <model name="ch4-air-2s-bfer_premix" title="CH4 AIR 2steps BFER PREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="air" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.7d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.8405d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6759d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.7d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=hmg;caption=Homogenerous equivalent compound- no reactions][] Species : AIR[]</desc>
+    </model>
+    <model name="ch4-air-2s-bfer_nonpremix" title="CH4 AIR 2steps BFER NONPREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="ch4;o2;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.7d0;0.7d0;0.7d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.8405d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6759d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.7d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=mspec;caption=Multispecies - no reactions][] Species : CH4 O2 N2[]</desc>
+    </model>
+    <model name="ch4-air-2s-bfer_flammable" title="CH4 AIR 2steps BFER FLAMMABLE">
+      <model layout="flat" name="reactions">
+        <model layout="flat" name="ch4-air-2s-bfer-1">
+          <info default="4" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="ch4;o2;co;h2o" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-1.5d0;1.d0;2.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="0.5d0;0.65d0;0.d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;0.d0;0.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="4.9d9" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="35500.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+          <info default="pea2" name="reac_pea_method" type="string" visibility="hidden"/>
+          <info default="1.10d0;0.09d0;0.37d0;1.13d0;0.03d0;6.7d0;1.6d0;0.22d0" name="reac_pea_coeff" type="string" visibility="hidden"/>
+        </model>
+        <model layout="flat" name="ch4-air-2s-bfer-2">
+          <info default="3" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="co;o2;co2" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-0.5d0;1.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="1.d0;0.5d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;1.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="-2.0d8" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="12000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.7d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+          <info default="pea2" name="reac_pea_method" type="string" visibility="hidden"/>
+          <info default="0.95d0;0.08d0;2.5d-5;1.3d0;0.04d0;0.0087d0;1.2d0;0.04d0;1.2d0;0.05d0" name="reac_pea_coeff" type="string" visibility="hidden"/>
+        </model>
+      </model>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="reduced_pea" name="chemistry" type="string" visibility="hidden"/>
+      <info default="ch4;co2;co;o2;h2o;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.7d0;0.7d0;0.7d0;0.7d0;0.7d0;0.7d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="1d0;0d0;0d0;0d0;0d0;0d0" name="species_fuel_tank" type="string" visibility="hidden"/>
+      <info default="0d0;0d0;0d0;0.233d0;0d0;0.767d0" name="species_oxy_tank" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.8405d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6759d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.7d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=flammable;caption=Multispecies - flammable][] Species : CH4 CO2 CO O2 H2O N2[]Chemistry : reduced_pea[][]===== REACTIONS =====[] ch4 + 1.5 o2 -} co + 2 h2o  [] co + 0.5 o2 {-} co2  []</desc>
+    </model>
+    <model name="kero_luche-air-2s-bfer_premix" title="KERO LUCHE AIR 2steps BFER PREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="air" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.739d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="2.5034d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="473.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6695d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.739d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=hmg;caption=Homogenerous equivalent compound- no reactions][] Species : AIR[]</desc>
+    </model>
+    <model name="kero_luche-air-2s-bfer_nonpremix" title="KERO LUCHE AIR 2steps BFER NONPREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="kero_luche;o2;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.739d0;0.739d0;0.739d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="2.5034d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="473.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6695d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.739d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=mspec;caption=Multispecies - no reactions][] Species : KERO_LUCHE O2 N2[]</desc>
+    </model>
+    <model name="kero_luche-air-2s-bfer_flammable" title="KERO LUCHE AIR 2steps BFER FLAMMABLE">
+      <model layout="flat" name="reactions">
+        <model layout="flat" name="kero_luche-air-2s-bfer-1">
+          <info default="4" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="kero_luche;o2;co;h2o" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-10d0;10.d0;10.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="0.55d0;0.9d0;0.d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;0.d0;0.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.8000d12" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="41500.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+          <info default="pea2" name="reac_pea_method" type="string" visibility="hidden"/>
+          <info default="1.173d0;0.04d0;0.29d0;1.2d0;0.02d0;7.1d0;1.8d0;0.18d0" name="reac_pea_coeff" type="string" visibility="hidden"/>
+        </model>
+        <model layout="flat" name="kero_luche-air-2s-bfer-2">
+          <info default="3" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="co;o2;co2" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-0.5d0;1.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="1.d0;0.5d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;1.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="-4.5d10" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="20000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+          <info default="pea2" name="reac_pea_method" type="string" visibility="hidden"/>
+          <info default="1.146d0;0.045d0;0.00015d0;1.2d0;0.04d0;0.035d0;1.215d0;0.03d0;1.32d0;0.09d0" name="reac_pea_coeff" type="string" visibility="hidden"/>
+        </model>
+      </model>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="reduced_pea" name="chemistry" type="string" visibility="hidden"/>
+      <info default="kero_luche;co2;co;o2;h2o;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.739d0;0.739d0;0.739d0;0.739d0;0.739d0;0.739d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="1d0;0d0;0d0;0d0;0d0;0d0" name="species_fuel_tank" type="string" visibility="hidden"/>
+      <info default="0d0;0d0;0d0;0.233d0;0d0;0.767d0" name="species_oxy_tank" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="2.5034d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="473.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.6695d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.739d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=flammable;caption=Multispecies - flammable][] Species : KERO_LUCHE CO2 CO O2 H2O N2[]Chemistry : reduced_pea[][]===== REACTIONS =====[] kero_luche + 10 o2 -} 10 co + 10 h2o  [] co + 0.5 o2 {-} co2  []</desc>
+    </model>
+    <model name="c7h16-air-2s_premix" title="C7H16 AIR 2steps PREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="air" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.726d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=hmg;caption=Homogenerous equivalent compound- no reactions][] Species : AIR[]</desc>
+    </model>
+    <model name="c7h16-air-2s_nonpremix" title="C7H16 AIR 2steps NONPREMIX">
+      <model layout="flat" name="reactions"/>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="no" name="chemistry" type="string" visibility="hidden"/>
+      <info default="c7h16;o2;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.677d0;0.739d0;0.726d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=mspec;caption=Multispecies - no reactions][] Species : C7H16 O2 N2[]</desc>
+    </model>
+    <model name="c7h16-air-2s_flammable" title="C7H16 AIR 2steps FLAMMABLE">
+      <model layout="flat" name="reactions">
+        <model layout="flat" name="c7h16-air-2s-1">
+          <info default="4" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="c7h16;o2;co;h2o" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-1.5d0;1.d0;2.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="0.9d0;1.1d0;0.d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;0.d0;0.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="2.0d15" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="35000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+        </model>
+        <model layout="flat" name="c7h16-air-2s-2">
+          <info default="3" name="reac_species_number" type="string" visibility="hidden"/>
+          <info default="co;o2;co2" name="reac_species_name" type="string" visibility="hidden"/>
+          <info default="-1.d0;-0.5d0;1.d0" name="reac_stoich_coeff" type="string" visibility="hidden"/>
+          <info default="1.d0;0.5d0;0.d0" name="reac_arrh_fwd_coeff" type="string" visibility="hidden"/>
+          <info default="0.d0;0.d0;1.d0" name="reac_arrh_bwd_coeff" type="string" visibility="hidden"/>
+          <info default="-2.0d9" name="reac_preexp" type="string" visibility="hidden"/>
+          <info default="12000.0d0" name="reac_act_energ" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_temp_exp" type="string" visibility="hidden"/>
+          <info default="0" name="reac_third_body_number" type="string" visibility="hidden"/>
+          <info default="no" name="reac_third_body_name" type="string" visibility="hidden"/>
+          <info default="0.d0" name="reac_third_body_eff" type="string" visibility="hidden"/>
+        </model>
+      </model>
+      <info default="computed" name="transport" type="string" visibility="hidden"/>
+      <info default="reduced" name="chemistry" type="string" visibility="hidden"/>
+      <info default="c7h16;co2;co;o2;h2o;n2" name="species_name" type="string" visibility="hidden"/>
+      <info default="0.677d0;0.945d0;0.750d0;0.739d0;0.544d0;0.726d0" name="species_schmidt_number" type="string" visibility="hidden"/>
+      <info default="1d0;0d0;0d0;0d0;0d0;0d0" name="species_fuel_tank" type="string" visibility="hidden"/>
+      <info default="0d0;0d0;0d0;0.233d0;0d0;0.767d0" name="species_oxy_tank" type="string" visibility="hidden"/>
+      <info default="power" name="viscosity_law" type="string" visibility="hidden"/>
+      <info default="1.807d-5" name="mu_ref" type="string" visibility="hidden"/>
+      <info default="300.d0" name="t_ref" type="string" visibility="hidden"/>
+      <info default="0.682d0" name="viscosity_law_coeff" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="prandtl_number" type="string" visibility="hidden"/>
+      <desc>[logo=flammable;caption=Multispecies - flammable][] Species : C7H16 CO2 CO O2 H2O N2[]Chemistry : reduced[][]===== REACTIONS =====[] c7h16 + 1.5 o2 -} co + 2 h2o  [] co + 0.5 o2 {-} co2  []</desc>
+    </model>
+  </xor>
+  <model layout="flat" name="species">
+    <model layout="flat" name="ch4">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="1" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="4" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0160423d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-66.911d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.14291d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.71d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-010.024d3;-006.698d3;-003.368d3;+000.066d3;+003.861d3;+008.200d3;+013.130d3;+018.635d3;+024.675d3;+031.205d3;+038.179d3;+045.549d3;+053.270d3;+061.302d3;+069.608d3;+078.153d3;+086.910d3;+095.853d3;+104.960d3;+114.212d3;+123.592d3;+133.087d3;+142.684d3;+152.371d3;+162.141d3;+171.984d3;+181.893d3;+191.862d3;+201.885d3;+211.958d3;+222.076d3;+232.235d3;+242.431d3;+252.662d3;+262.925d3;+273.217d3;+283.536d3;+293.881d3;+304.248d3;+314.637d3;+325.045d3;+335.473d3;+345.918d3;+356.379d3;+366.855d3;+377.345d3;+387.849d3;+398.365d3;+408.893d3;+419.432d3;+429.982d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;149.500d0;172.577d0;186.472d0;197.356d0;207.014d0;215.987d0;224.461d0;232.518d0;240.205d0;247.549d0;254.570d0;261.287d0;267.714d0;273.868d0;279.763d0;285.413d0;290.834d0;296.039d0;301.041d0;305.853d0;310.485d0;314.949d0;319.255d0;323.413d0;327.431d0;331.317d0;335.080d0;338.725d0;342.260d0;345.690d0;349.021d0;352.258d0;355.406d0;358.470d0;361.453d0;364.360d0;367.194d0;369.959d0;372.658d0;375.293d0;377.868d0;380.385d0;382.846d0;385.255d0;387.612d0;389.921d0;392.182d0;394.399d0;396.572d0;398.703d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="c3h8">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="3" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="8" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.04409721000d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-82.4d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="8.23626d-6" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.823d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.1217272222d+05;-.1030662319d+05;-.6188330782d+04;0.1364405195d+03;0.8552806112d+04;0.1889515618d+05;0.3096560059d+05;0.4455241379d+05;0.5944847973d+05;0.7546973676d+05;0.9247362251d+05;0.1102940639d+06;0.1287918538d+06;0.1479086766d+06;0.1675897638d+06;0.1877836779d+06;0.2084422163d+06;0.2295203152d+06;0.2509759538d+06;0.2727700578d+06;0.2948664040d+06;0.3172315236d+06;0.3398346067d+06;0.3626474061d+06;0.3856441411d+06;0.4088014018d+06;0.4320980527d+06;0.4555151369d+06;0.4790357801d+06;0.5026450943d+06;0.5263300823d+06;0.5500795409d+06;0.5738839656d+06;0.5977354542d+06;0.6216276108d+06;0.6455554497d+06;0.6695152997d+06;0.6935047076d+06;0.7175223427d+06;0.7415679001d+06;0.7656420055d+06;0.7897461183d+06;0.8138824362d+06;0.8380537990d+06;0.8622635923d+06;0.8865156520d+06;0.9108141677d+06;0.9351635871d+06;0.9595685198d+06;0.9840336410d+06;0.1008563596d+07" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.2176330606d+03;0.2452872469d+03;0.2706366540d+03;0.2947100442d+03;0.3177123459d+03;0.3396743962d+03;0.3605906247d+03;0.3804635434d+03;0.3993217861d+03;0.4172285760d+03;0.4342080590d+03;0.4502991550d+03;0.4655976216d+03;0.4801804139d+03;0.4941108385d+03;0.5074420209d+03;0.5202193195d+03;0.5324820488d+03;0.5442647360d+03;0.5555980549d+03;0.5665095317d+03;0.5770240866d+03;0.5871644546d+03;0.5969515170d+03;0.6064045650d+03;0.6155415115d+03;0.6243790634d+03;0.6329328617d+03;0.6412175976d+03;0.6492471093d+03;0.6570344614d+03;0.6645920138d+03;0.6719314780d+03;0.6790639666d+03;0.6860000342d+03;0.6927497138d+03;0.6993225475d+03;0.7057276133d+03;0.7119735480d+03;0.7180685682d+03;0.7240204876d+03;0.7298367331d+03;0.7355243581d+03;0.7410900552d+03;0.7465401669d+03;0.7518806955d+03;0.7571173111d+03;0.7622553600d+03;0.7672998715d+03;0.7722555637d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="c2h5oh">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="2" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="6" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.04606952000d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-217.4d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="7.97901d-06" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.925d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.1445314193d+05;-.1039393329d+05;-.5729511623d+04;0.1210752689d+03;0.7436864443d+04;0.1626515662d+05;0.2649169498d+05;0.3791084394d+05;0.5029576795d+05;0.6346861030d+05;0.7737067187d+05;0.9193607602d+05;0.1070175641d+06;0.1225681964d+06;0.1385441082d+06;0.1549044055d+06;0.1716110630d+06;0.1886288217d+06;0.2059250866d+06;0.2234698243d+06;0.2412354606d+06;0.2591967782d+06;0.2773308144d+06;0.2956167586d+06;0.3140358503d+06;0.3325712762d+06;0.3512080684d+06;0.3699330018d+06;0.3887344915d+06;0.4076024910d+06;0.4265283896d+06;0.4455049098d+06;0.4645260053d+06;0.4835867586d+06;0.5026832784d+06;0.5218125976d+06;0.5409725707d+06;0.5601617715d+06;0.5793793909d+06;0.5986251345d+06;0.6178991198d+06;0.6372017748d+06;0.6565337347d+06;0.6758957400d+06;0.6952885343d+06;0.7147127616d+06;0.7341688641d+06;0.7536569799d+06;0.7731768406d+06;0.7927276689d+06;0.8123080765d+06" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.2255066585d+03;0.2574629103d+03;0.2809976941d+03;0.3019389110d+03;0.3215773376d+03;0.3401863352d+03;0.3577676958d+03;0.3742926489d+03;0.3897995788d+03;0.4044398984d+03;0.4183181186d+03;0.4314376242d+03;0.4438823863d+03;0.4557199600d+03;0.4670059513d+03;0.4777870415d+03;0.4881030918d+03;0.4979886462d+03;0.5074740277d+03;0.5165861520d+03;0.5253491436d+03;0.5337848080d+03;0.5419129984d+03;0.5497519050d+03;0.5573182849d+03;0.5646276466d+03;0.5716944004d+03;0.5785319807d+03;0.5851529472d+03;0.5915690688d+03;0.5977913937d+03;0.6038303087d+03;0.6096955890d+03;0.6153964407d+03;0.6209415370d+03;0.6263390497d+03;0.6315966759d+03;0.6367216615d+03;0.6417208212d+03;0.6466005566d+03;0.6513668717d+03;0.6560253863d+03;0.6605813485d+03;0.6650396447d+03;0.6694048100d+03;0.6736810357d+03;0.6778721776d+03;0.6819817621d+03;0.6860129928d+03;0.6899687555d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="783.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="17.60d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="513.92d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="167.d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="1.300000d+06;1.291000d+06;1.282000d+06;1.273000d+06;1.264000d+06;1.255000d+06;1.246000d+06;1.237000d+06;1.228000d+06;1.219000d+06;1.210000d+06;1.204000d+06;1.198000d+06;1.192000d+06;1.186000d+06;1.180000d+06;1.174000d+06;1.168000d+06;1.162000d+06;1.156000d+06;1.150000d+06;1.137500d+06;1.125000d+06;1.112500d+06;1.100000d+06;1.087500d+06;1.075000d+06;1.062500d+06;1.050000d+06;1.037500d+06;1.025000d+06;1.009000d+06;0.993000d+06;0.977000d+06;0.961000d+06;0.945000d+06;0.929000d+06;0.913000d+06;0.897000d+06;0.881000d+06;0.865000d+06;0.825060d+06;0.785120d+06;0.745180d+06;0.705240d+06;0.665300d+06;0.625360d+06;0.585420d+06;0.545480d+06;0.505540d+06;0.410000d+06;0.115460d+06;0.000000d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.001000d+05;0.003000d+05;0.006650d+05;0.013500d+05;0.026500d+05;0.049500d+05;0.086000d+05;0.150000d+05;0.245000d+05;0.395000d+05;0.600000d+05;0.900000d+05;1.320000d+05;1.900000d+05;2.660000d+05;3.650000d+05;4.920000d+05;6.480000d+05;8.400000d+05;11.100000d+05;14.200000d+05;18.000000d+05;22.000000d+05;26.500000d+05;32.900000d+05;40.000000d+05;47.500000d+05;56.000000d+05;65.500000d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;1.900000d-03;1.900000d-03;1.900000d-03;1.900000d-03;1.900000d-03;1.570000d-03;1.280000d-03;1.050000d-03;0.871000d-03;0.730000d-03;0.620000d-03;0.527000d-03;0.453000d-03;0.388000d-03;0.334000d-03;0.291000d-03;0.254000d-03;0.223000d-03;0.198000d-03;0.175000d-03;0.156000d-03;0.139000d-03;0.124000d-03;0.111000d-03;0.098800d-03;0.087200d-03;0.076000d-03;0.064900d-03;0.052800d-03;0.040200d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="c7h16">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="7" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="16" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.100202d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-154.559d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="5.93152d-6" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.92d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.2482950522d+05;-.2247455762d+05;-.1384325144d+05;0.3076979067d+03;0.1929478631d+05;0.4250368225d+05;0.6938518797d+05;0.9945120082d+05;0.1322706744d+06;0.1674655799d+06;0.2047068673d+06;0.2437104266d+06;0.2842330490d+06;0.3260683883d+06;0.3690426517d+06;0.4129826561d+06;0.4577700177d+06;0.5033241058d+06;0.5495700453d+06;0.5964385054d+06;0.6438654871d+06;0.6917921121d+06;0.7401644103d+06;0.7889331088d+06;0.8380534195d+06;0.8874848278d+06;0.9371908802d+06;0.9871389733d+06;0.1037300141d+07;0.1087648845d+07;0.1138162759d+07;0.1188822560d+07;0.1239611717d+07;0.1290516278d+07;0.1341524655d+07;0.1392627420d+07;0.1443817086d+07;0.1495087898d+07;0.1546435622d+07;0.1597857331d+07;0.1649351196d+07;0.1700916272d+07;0.1752552288d+07;0.1804259432d+07;0.1856038143d+07;0.1907888898d+07;0.1959811999d+07;0.2011807362d+07;0.2063874306d+07;0.2116011339d+07;0.2168215950d+07" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.3144425846d+03;0.3719260990d+03;0.4285963424d+03;0.4829073128d+03;0.5345331275d+03;0.5834492032d+03;0.6297375537d+03;0.6735238744d+03;0.7149520334d+03;0.7541720963d+03;0.7913340888d+03;0.8265844851d+03;0.8600641065d+03;0.8919066063d+03;0.9222185480d+03;0.9511208509d+03;0.9787356137d+03;0.1005167272d+04;0.1030506310d+04;0.1054832013d+04;0.1078214556d+04;0.1100716599d+04;0.1122394530d+04;0.1143299446d+04;0.1163477927d+04;0.1182972665d+04;0.1201822970d+04;0.1220065185d+04;0.1237733029d+04;0.1254857881d+04;0.1271469017d+04;0.1287593811d+04;0.1303257903d+04;0.1318485342d+04;0.1333298711d+04;0.1347719234d+04;0.1361766861d+04;0.1375460354d+04;0.1388817352d+04;0.1401854432d+04;0.1414587160d+04;0.1427030141d+04;0.1439197057d+04;0.1451100701d+04;0.1462753016d+04;0.1474165117d+04;0.1485347319d+04;0.1496309159d+04;0.1507059419d+04;0.1517606142d+04" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="688.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="14.66d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="540.20d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="428.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.485700d+06;0.481530d+06;0.477360d+06;0.473190d+06;0.469020d+06;0.464850d+06;0.460680d+06;0.456510d+06;0.452340d+06;0.448170d+06;0.444000d+06;0.439830d+06;0.435660d+06;0.431490d+06;0.427320d+06;0.423150d+06;0.418980d+06;0.414810d+06;0.410640d+06;0.406470d+06;0.402300d+06;0.398130d+06;0.393960d+06;0.389790d+06;0.385620d+06;0.381450d+06;0.377280d+06;0.373110d+06;0.368940d+06;0.364770d+06;0.360600d+06;0.354040d+06;0.347480d+06;0.340920d+06;0.334360d+06;0.327800d+06;0.321240d+06;0.314680d+06;0.308120d+06;0.301560d+06;0.295000d+06;0.286530d+06;0.278060d+06;0.269590d+06;0.261120d+06;0.252660d+06;0.244190d+06;0.235720d+06;0.227250d+06;0.218780d+06;0.176300d+06;0.132400d+06;0.088501d+06;0.044602d+06;0.000702d+06;0.000000d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.027400d+05;0.047200d+05;0.077800d+05;0.123000d+05;0.189000d+05;0.280000d+05;0.405000d+05;0.570000d+05;0.786000d+05;1.060000d+05;1.410000d+05;1.830000d+05;2.350000d+05;2.980000d+05;3.720000d+05;4.600000d+05;5.600000d+05;6.780000d+05;8.140000d+05;9.710000d+05;11.510000d+05;13.540000d+05;15.860000d+05;18.470000d+05;21.400000d+05;24.650000d+05;27.360000d+05;30.300000d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;1.030000d-03;0.859000d-03;0.729000d-03;0.629000d-03;0.549000d-03;0.485000d-03;0.431000d-03;0.386000d-03;0.349000d-03;0.317000d-03;0.290000d-03;0.267000d-03;0.246000d-03;0.224000d-03;0.204000d-03;0.186000d-03;0.172000d-03;0.159000d-03;0.146000d-03;0.135000d-03;0.125000d-03;0.115000d-03;0.106000d-03;0.097100d-03;0.089200d-03;0.081800d-03;0.074500d-03;0.067400d-03;0.060300d-03;0.053700d-03;0.046900d-03;0.027200d-03;0.001220d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="c8h18">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="8" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="18" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.1142326600d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-170.62d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="6.0209d-6" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.925d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.2540002878d+05;-.2447979600d+05;-.1552687797d+05;0.3505342844d+03;0.2217241299d+05;0.4907803879d+05;0.8031714594d+05;0.1152410675d+06;0.1532938805d+06;0.1940035511d+06;0.2369730798d+06;0.2818716467d+06;0.3284257564d+06;0.3764103837d+06;0.4256400596d+06;0.4759262262d+06;0.5271316239d+06;0.5791683177d+06;0.6319546716d+06;0.6854151164d+06;0.7394799171d+06;0.7940849409d+06;0.8491714249d+06;0.9046857437d+06;0.9605791772d+06;0.1016807678d+07;0.1073331641d+07;0.1130115666d+07;0.1187128333d+07;0.1244341965d+07;0.1301732393d+07;0.1359278733d+07;0.1416963144d+07;0.1474770601d+07;0.1532688661d+07;0.1590707234d+07;0.1648818344d+07;0.1707015904d+07;0.1765295478d+07;0.1823654052d+07;0.1882089801d+07;0.1940601858d+07;0.1999190078d+07;0.2057854809d+07;0.2116596659d+07;0.2175416263d+07;0.2234314053d+07;0.2293290021d+07;0.2352343491d+07;0.2411472887d+07;0.2470675497d+07" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.3020533611d+03;0.3611392744d+03;0.4246388080d+03;0.4870375536d+03;0.5468810791d+03;0.6037260941d+03;0.6574943848d+03;0.7082640491d+03;0.7561848528d+03;0.8014384922d+03;0.8442178983d+03;0.8847155831d+03;0.9231166680d+03;0.9595944640d+03;0.9942845050d+03;0.1027328677d+04;0.1058873308d+04;0.1089043215d+04;0.1117946237d+04;0.1145676602d+04;0.1172317471d+04;0.1197942894d+04;0.1222619324d+04;0.1246406816d+04;0.1269359974d+04;0.1291528720d+04;0.1312958909d+04;0.1333692837d+04;0.1353769662d+04;0.1373225749d+04;0.1392094960d+04;0.1410408901d+04;0.1428197122d+04;0.1445487301d+04;0.1462305389d+04;0.1478675740d+04;0.1494621221d+04;0.1510163314d+04;0.1525322194d+04;0.1540116804d+04;0.1554564921d+04;0.1568683211d+04;0.1582487278d+04;0.1595991712d+04;0.1609210124d+04;0.1622155183d+04;0.1634838646d+04;0.1647271386d+04;0.1659463420d+04;0.1671423925d+04" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="699.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="16.22d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="568.70d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="492.d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.542000d+06;0.536000d+06;0.530000d+06;0.524000d+06;0.518000d+06;0.512000d+06;0.506000d+06;0.500000d+06;0.494000d+06;0.488000d+06;0.482000d+06;0.476000d+06;0.470000d+06;0.464000d+06;0.458000d+06;0.452000d+06;0.446000d+06;0.440000d+06;0.434000d+06;0.428000d+06;0.422000d+06;0.416000d+06;0.410000d+06;0.404000d+06;0.398000d+06;0.392000d+06;0.386000d+06;0.380000d+06;0.374000d+06;0.368000d+06;0.362000d+06;0.356000d+06;0.350000d+06;0.344000d+06;0.338000d+06;0.332000d+06;0.326000d+06;0.320000d+06;0.314000d+06;0.308000d+06;0.302000d+06;0.296740d+06;0.291490d+06;0.286230d+06;0.280980d+06;0.275720d+06;0.270470d+06;0.265210d+06;0.259960d+06;0.254700d+06;0.213000d+06;0.182290d+06;0.151570d+06;0.120860d+06;0.090145d+06;0.059431d+06;0.028717d+06;0.000000d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000647d+05;0.001490d+05;0.003200d+05;0.006380d+05;0.012000d+05;0.021400d+05;0.036300d+05;0.059400d+05;0.093300d+05;0.142000d+05;0.210000d+05;0.303000d+05;0.427000d+05;0.588000d+05;0.795000d+05;1.057000d+05;1.380000d+05;1.780000d+05;2.250000d+05;2.830000d+05;3.500000d+05;4.290000d+05;5.200000d+05;6.250000d+05;7.450000d+05;8.840000d+05;10.430000d+05;12.230000d+05;14.270000d+05;16.580000d+05;19.170000d+05;22.050000d+05;24.960000d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;1.560000d-03;1.250000d-03;1.030000d-03;0.872000d-03;0.750000d-03;0.651000d-03;0.570000d-03;0.505000d-03;0.451000d-03;0.406000d-03;0.367000d-03;0.335000d-03;0.307000d-03;0.282000d-03;0.262000d-03;0.241000d-03;0.220000d-03;0.200000d-03;0.182000d-03;0.168000d-03;0.155000d-03;0.143000d-03;0.132000d-03;0.122000d-03;0.112000d-03;0.103000d-03;0.094500d-03;0.086500d-03;0.079000d-03;0.071800d-03;0.064900d-03;0.058200d-03;0.051400d-03;0.043700d-03;0.024900d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="jp10">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="10" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="16" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.1362380d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-31.57400d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="6.0102d-06" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.96d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="1.362380d-01;-3.157400d+04;6.0102d-06;300.0d+00;0.96d+00;-2.299700d+04;-1.938700d+04;-1.195427d+04;2.860274d+02;1.906614d+04;4.405332d+04;7.451287d+04;1.095132d+05;1.481311d+05;1.896566d+05;2.337981d+05;2.801862d+05;3.282370d+05;3.777839d+05;4.286732d+05;4.807630d+05;5.339233d+05;5.880351d+05;6.429899d+05;6.986893d+05;7.550448d+05;8.119766d+05;8.694136d+05;9.272929d+05;9.855591d+05;1.044164d+06;1.103065d+06;1.162228d+06;1.221621d+06;1.281219d+06;1.341003d+06;1.400955d+06;1.461063d+06;1.521316d+06;1.581707d+06;1.642230d+06;1.702882d+06;1.763659d+06;1.824558d+06;1.885579d+06;1.946716d+06;2.007967d+06;2.069326d+06;2.130785d+06;2.192335d+06;2.253961d+06;2.315647d+06;2.377373d+06;2.439113d+06;2.500837d+06;2.562509d+06" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="2.555780d+02;2.727376d+02;3.112504d+02;3.601490d+02;4.137304d+02;4.692431d+02;5.246382d+02;5.785111d+02;6.300304d+02;6.789095d+02;7.253928d+02;7.695921d+02;8.113918d+02;8.510429d+02;8.887501d+02;9.246839d+02;9.589893d+02;9.917916d+02;1.023201d+03;1.053314d+03;1.082219d+03;1.109995d+03;1.136714d+03;1.162442d+03;1.187239d+03;1.211162d+03;1.234264d+03;1.256591d+03;1.278191d+03;1.299105d+03;1.319372d+03;1.339030d+03;1.358114d+03;1.376654d+03;1.394683d+03;1.412227d+03;1.429313d+03;1.445965d+03;1.462206d+03;1.478056d+03;1.493535d+03;1.508659d+03;1.523445d+03;1.537907d+03;1.552057d+03;1.565906d+03;1.579464d+03;1.592739d+03;1.605737d+03;1.618464d+03;1.630923d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="796.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="18.60d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="617.70d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="624.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.852534d+06;0.834184d+06;0.815834d+06;0.797483d+06;0.779133d+06;0.760783d+06;0.742433d+06;0.724083d+06;0.705732d+06;0.687382d+06;0.669032d+06;0.653488d+06;0.637943d+06;0.622399d+06;0.606855d+06;0.591310d+06;0.575766d+06;0.560222d+06;0.544677d+06;0.529133d+06;0.513589d+06;0.501573d+06;0.489558d+06;0.477542d+06;0.465527d+06;0.453511d+06;0.441496d+06;0.429480d+06;0.417465d+06;0.405449d+06;0.393434d+06;0.386219d+06;0.379003d+06;0.371788d+06;0.364573d+06;0.357358d+06;0.350142d+06;0.342927d+06;0.335712d+06;0.328497d+06;0.321282d+06;0.318622d+06;0.315963d+06;0.313304d+06;0.310645d+06;0.307986d+06;0.305327d+06;0.302667d+06;0.300008d+06;0.297349d+06;0.294690d+06;0.296048d+06;0.297405d+06;0.298763d+06;0.300120d+06;0.301478d+06;0.302836d+06;0.304193d+06;0.305551d+06;0.306908d+06;0.308266d+06;0.312956d+06;0.317647d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000000d+05;0.0000001d+05;0.0000007d+05;0.0000023d+05;0.0000070d+05;0.0000188d+05;0.0000465d+05;0.0001070d+05;0.0002308d+05;0.0004705d+05;0.0009113d+05;0.0016866d+05;0.0029957d+05;0.0051274d+05;0.0084861d+05;0.0136224d+05;0.0212671d+05;0.0323675d+05;0.0481256d+05;0.0700376d+05;0.0999333d+05;0.1400141d+05;0.1928904d+05;0.2616146d+05;0.3497124d+05;0.4612084d+05;0.6006486d+05;0.7731163d+05;0.9842445d+05;1.2402209d+05;1.5477897d+05;1.9142462d+05;2.3474276d+05;2.8556983d+05;3.4479312d+05;4.1334845d+05;4.9221754d+05;5.8242501d+05;6.8503513d+05;8.0114834d+05;9.3189761d+05;10.784446d+05;12.419759d+05;14.236990d+05;16.248380d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;2.430000d-03;2.430000d-03;2.060000d-03;1.650000d-03;1.350000d-03;1.120000d-03;0.953000d-03;0.819000d-03;0.712000d-03;0.626000d-03;0.556000d-03;0.497000d-03;0.448000d-03;0.406000d-03;0.370000d-03;0.339000d-03;0.312000d-03;0.287000d-03;0.266000d-03;0.246000d-03;0.228000d-03;0.212000d-03;0.197000d-03;0.183000d-03;0.170000d-03;0.159000d-03;0.147000d-03;0.137000d-03;0.127000d-03;0.118000d-03;0.109000d-03;0.101000d-03;0.093200d-03;0.085900d-03;0.079100d-03;0.072600d-03;0.066500d-03;0.060800d-03;0.055300d-03;0.050300d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="kero">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="10" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="22" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.1302815d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-220.070d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="6.05743d-06" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.935d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-2.355289d+05;-2.332093d+05;-2.227043d+05;-2.050727d+05;-1.812328d+05;-1.519818d+05;-1.180163d+05;-7.995198d+04;-3.834355d+04;6.295152d+03;5.347127d+04;1.026912d+05;1.536647d+05;2.062211d+05;2.602013d+05;3.154587d+05;3.718578d+05;4.292744d+05;4.875947d+05;5.467152d+05;6.065419d+05;6.669899d+05;7.279832d+05;7.894538d+05;8.513416d+05;9.135937d+05;9.761641d+05;1.039013d+06;1.102106d+06;1.165416d+06;1.228917d+06;1.292592d+06;1.356426d+06;1.420405d+06;1.484522d+06;1.548770d+06;1.613146d+06;1.677647d+06;1.742271d+06;1.807019d+06;1.871888d+06;1.936879d+06;2.001990d+06;2.067219d+06;2.132560d+06;2.198007d+06;2.263551d+06;2.329180d+06;2.394877d+06;2.460622d+06;2.526390d+06" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.000000d+00;3.543968d+02;4.241723d+02;4.947527d+02;5.629367d+02;6.279989d+02;6.898036d+02;7.484045d+02;8.039161d+02;8.564607d+02;9.061445d+02;9.530427d+02;9.973849d+02;1.039444d+03;1.079442d+03;1.117561d+03;1.153956d+03;1.188762d+03;1.222095d+03;1.254057d+03;1.284743d+03;1.314235d+03;1.342608d+03;1.369932d+03;1.396270d+03;1.421683d+03;1.446223d+03;1.469942d+03;1.492887d+03;1.515103d+03;1.536631d+03;1.557510d+03;1.577776d+03;1.597463d+03;1.616604d+03;1.635228d+03;1.653363d+03;1.671035d+03;1.688270d+03;1.705088d+03;1.721511d+03;1.737559d+03;1.753249d+03;1.768598d+03;1.783620d+03;1.798327d+03;1.812733d+03;1.826847d+03;1.840679d+03;1.854235d+03;1.867522d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="782.035d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="18.60d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="617.70d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="624.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="1.1751261d+06;1.1468295d+06;1.1185330d+06;1.0902364d+06;1.0619399d+06;1.0336433d+06;1.0053468d+06;0.9770502d+06;0.9487536d+06;0.9204571d+06;0.8921605d+06;0.8701469d+06;0.8481332d+06;0.8261195d+06;0.8041058d+06;0.7820921d+06;0.7600784d+06;0.7380647d+06;0.7160510d+06;0.6940373d+06;0.6720236d+06;0.6554801d+06;0.6389366d+06;0.6223930d+06;0.6058495d+06;0.5893060d+06;0.5727624d+06;0.5562189d+06;0.5396753d+06;0.5231318d+06;0.5065883d+06;0.4948100d+06;0.4830318d+06;0.4712536d+06;0.4594753d+06;0.4476971d+06;0.4359188d+06;0.4241406d+06;0.4123624d+06;0.4005841d+06;0.3888059d+06;0.3811810d+06;0.3735562d+06;0.3659313d+06;0.3583065d+06;0.3506816d+06;0.3430568d+06;0.3354319d+06;0.3278071d+06;0.3201823d+06;0.3125574d+06;0.3085513d+06;0.3045451d+06;0.3005390d+06;0.2965328d+06;0.2925267d+06;0.2885205d+06;0.2845144d+06;0.2805082d+06;0.2765021d+06;0.2724959d+06;0.2716359d+06;0.2707759d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000001d+05;0.000003d+05;0.000008d+05;0.000021d+05;0.000050d+05;0.000109d+05;0.000224d+05;0.000439d+05;0.000819d+05;0.001466d+05;0.002528d+05;0.004212d+05;0.006805d+05;0.010687d+05;0.016357d+05;0.024449d+05;0.035759d+05;0.051265d+05;0.072149d+05;0.099821d+05;0.135937d+05;0.182417d+05;0.241463d+05;0.315574d+05;0.407554d+05;0.520522d+05;0.657917d+05;0.823502d+05;1.021361d+05;1.255893d+05;1.531814d+05;1.854136d+05;2.228167d+05;2.659488d+05;3.153942d+05;3.717616d+05;4.356822d+05;5.078073d+05;5.888069d+05;6.793669d+05;7.801871d+05;8.919790d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;2.430000d-03;2.430000d-03;2.060000d-03;1.650000d-03;1.350000d-03;1.120000d-03;0.953000d-03;0.819000d-03;0.712000d-03;0.626000d-03;0.556000d-03;0.497000d-03;0.448000d-03;0.406000d-03;0.370000d-03;0.339000d-03;0.312000d-03;0.287000d-03;0.266000d-03;0.246000d-03;0.228000d-03;0.212000d-03;0.197000d-03;0.183000d-03;0.170000d-03;0.159000d-03;0.147000d-03;0.137000d-03;0.127000d-03;0.118000d-03;0.109000d-03;0.101000d-03;0.093200d-03;0.085900d-03;0.079100d-03;0.072600d-03;0.066500d-03;0.060800d-03;0.055300d-03;0.050300d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="kero_luche">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous_and_liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="10" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="20" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.137208261720d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-141.367803780d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="6.05743d-06" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.935d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-236434.084347d0;-232875.680845d0;-222200.312192d0;-204408.137290d0;-179499.071196d0;-148933.996870d0;-113469.599689d0;-73744.472008d0;-30320.211222d0;16276.681938d0;65513.394122d0;116859.604292d0;170026.077420d0;224839.920510d0;281140.576620d0;338779.379410d0;397618.843860d0;457532.521050d0;518404.391310d0;580128.454490d0;642608.230110d0;705756.183350d0;769493.637210d0;833749.850760d0;898462.001170d0;963574.220840d0;1029037.461650d0;1094809.938520d0;1160853.764700d0;1227138.299400d0;1293637.024300d0;1360328.416300d0;1427192.472400d0;1494214.984700d0;1561383.635700d0;1628687.505300d0;1696119.221700d0;1763672.152700d0;1831341.474700d0;1899120.624400d0;1967007.216600d0;2034995.729000d0;2103080.626400d0;2171256.427400d0;2239515.857100d0;2307848.147100d0;2376242.117800d0;2444684.179200d0;2513155.247600d0;2581634.568500d0;2650097.441800d0" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.00000000d0;170.18721435d0;342.31308345d0;510.45211056d0;581.62605636d0;649.62963814d0;714.15767073d0;775.31689155d0;833.25055057d0;888.10014517d0;939.95436852d0;988.87785365d0;1035.12778617d0;1078.99440305d0;1120.71098576d0;1160.47224050d0;1198.44264734d0;1234.76199830d0;1269.55314376d0;1302.92383456d0;1334.96976220d0;1365.77840740d0;1395.42801100d0;1423.99060540d0;1451.53133210d0;1478.11078420d0;1503.78547260d0;1528.60807140d0;1552.62606360d0;1575.88630140d0;1598.42976010d0;1620.29789410d0;1641.52793880d0;1662.15514330d0;1682.21353700d0;1701.73456020d0;1720.74906430d0;1739.28450310d0;1757.36781040d0;1775.02422020d0;1792.27819990d0;1809.14995700d0;1825.66184890d0;1841.83286340d0;1857.68004290d0;1873.22082710d0;1888.47021730d0;1903.44177650d0;1918.14836900d0;1932.60207760d0;1946.81247880d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="781.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="18.60d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="617.70d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="624.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.656498d+06;0.639062d+06;0.621625d+06;0.604189d+06;0.586752d+06;0.569315d+06;0.551879d+06;0.534442d+06;0.517006d+06;0.499569d+06;0.482133d+06;0.469883d+06;0.457633d+06;0.445384d+06;0.433134d+06;0.420885d+06;0.408635d+06;0.396385d+06;0.384136d+06;0.371886d+06;0.359637d+06;0.352574d+06;0.345511d+06;0.338449d+06;0.331386d+06;0.324323d+06;0.317260d+06;0.310198d+06;0.303135d+06;0.296072d+06;0.289010d+06;0.287134d+06;0.285258d+06;0.283382d+06;0.281506d+06;0.279631d+06;0.277755d+06;0.275879d+06;0.274003d+06;0.272127d+06;0.270252d+06;0.272498d+06;0.274744d+06;0.276991d+06;0.279237d+06;0.281484d+06;0.283730d+06;0.285976d+06;0.288223d+06;0.290469d+06;0.292716d+06;0.298533d+06;0.304350d+06;0.310167d+06;0.315984d+06;0.321801d+06;0.327618d+06;0.333436d+06;0.339253d+06;0.345070d+06;0.350887d+06;0.359809d+06;0.368732d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000001d+05;0.000006d+05;0.000017d+05;0.000044d+05;0.000105d+05;0.000233d+05;0.000486d+05;0.000959d+05;0.001802d+05;0.003243d+05;0.005611d+05;0.009372d+05;0.015158d+05;0.023812d+05;0.036426d+05;0.054386d+05;0.079412d+05;0.113605d+05;0.159487d+05;0.220038d+05;0.298731d+05;0.399564d+05;0.527082d+05;0.686396d+05;0.883197d+05;1.123763d+05;1.414957d+05;1.764223d+05;2.179574d+05;2.669574d+05;3.243319d+05;3.910405d+05;4.680900d+05;5.565314d+05;6.574553d+05;7.719886d+05;9.012902d+05;10.465468d+05;12.089684d+05;13.897839d+05;15.902371d+05;18.115818d+05;20.550782d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;2.430000d-03;2.430000d-03;2.060000d-03;1.650000d-03;1.350000d-03;1.120000d-03;0.953000d-03;0.819000d-03;0.712000d-03;0.626000d-03;0.556000d-03;0.497000d-03;0.448000d-03;0.406000d-03;0.370000d-03;0.339000d-03;0.312000d-03;0.287000d-03;0.266000d-03;0.246000d-03;0.228000d-03;0.212000d-03;0.197000d-03;0.183000d-03;0.170000d-03;0.159000d-03;0.147000d-03;0.137000d-03;0.127000d-03;0.118000d-03;0.109000d-03;0.101000d-03;0.093200d-03;0.085900d-03;0.079100d-03;0.072600d-03;0.066500d-03;0.060800d-03;0.055300d-03;0.050300d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="n2">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0280134d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.80968d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-008.670d3;-005.768d3;-002.857d3;+000.054d3;+002.971d3;+005.911d3;+008.894d3;+011.937d3;+015.046d3;+018.223d3;+021.463d3;+024.760d3;+028.109d3;+031.503d3;+034.936d3;+038.405d3;+041.904d3;+045.429d3;+048.978d3;+052.548d3;+056.137d3;+059.742d3;+063.361d3;+066.995d3;+070.640d3;+074.296d3;+077.963d3;+081.639d3;+085.323d3;+089.015d3;+092.715d3;+096.421d3;+100.134d3;+103.852d3;+107.577d3;+111.306d3;+115.041d3;+118.781d3;+122.525d3;+126.274d3;+130.027d3;+133.784d3;+137.545d3;+141.309d3;+145.078d3;+148.850d3;+152.625d3;+156.405d3;+160.187d3;+163.973d3;+167.763d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;159.811d0;179.985d0;191.789d0;200.181d0;206.739d0;212.176d0;216.866d0;221.017d0;224.757d0;228.170d0;231.313d0;234.226d0;236.943d0;239.487d0;241.880d0;244.138d0;246.275d0;248.304d0;250.234d0;252.074d0;253.833d0;255.517d0;257.132d0;258.684d0;260.176d0;261.614d0;263.001d0;264.341d0;265.637d0;266.891d0;268.106d0;269.285d0;270.429d0;271.541d0;272.622d0;273.675d0;274.699d0;275.698d0;276.671d0;277.622d0;278.549d0;279.456d0;280.341d0;281.208d0;282.056d0;282.885d0;283.698d0;284.494d0;285.275d0;286.041d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="co">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="1" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0280140d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-113.810d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.77714d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-008.671d3;-005.769d3;-002.858d3;+000.054d3;+002.976d3;+005.931d3;+008.942d3;+012.023d3;+015.177d3;+018.401d3;+021.690d3;+025.035d3;+028.430d3;+031.868d3;+035.343d3;+038.850d3;+042.385d3;+045.945d3;+049.526d3;+053.126d3;+056.744d3;+060.376d3;+064.021d3;+067.679d3;+071.348d3;+075.027d3;+078.715d3;+082.411d3;+086.116d3;+089.827d3;+093.546d3;+097.271d3;+101.001d3;+104.738d3;+108.480d3;+112.227d3;+115.978d3;+119.735d3;+123.496d3;+127.261d3;+131.031d3;+134.804d3;+138.582d3;+142.363d3;+146.148d3;+149.937d3;+153.729d3;+157.525d3;+161.324d3;+165.126d3;+168.932d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;165.850d0;186.025d0;197.833d0;206.283d0;212.831d0;218.319d0;223.066d0;227.277d0;231.074d0;234.538d0;237.726d0;240.679d0;243.431d0;246.006d0;248.426d0;250.707d0;252.865d0;254.912d0;256.859d0;258.714d0;260.486d0;262.182d0;263.808d0;265.369d0;266.871d0;268.318d0;269.713d0;271.060d0;272.362d0;273.623d0;274.844d0;276.029d0;277.178d0;278.295d0;279.382d0;280.438d0;281.468d0;282.471d0;283.449d0;284.403d0;285.335d0;286.245d0;287.135d0;288.005d0;288.856d0;289.690d0;290.506d0;291.306d0;292.090d0;292.859d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="co2">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="1" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0440098d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-393.151d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.50723d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.80d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-009.364d3;-006.456d3;-003.414d3;+000.069d3;+004.003d3;+008.305d3;+012.907d3;+017.754d3;+022.806d3;+028.030d3;+033.397d3;+038.884d3;+044.473d3;+050.148d3;+055.896d3;+061.705d3;+067.569d3;+073.480d3;+079.431d3;+085.419d3;+091.439d3;+097.488d3;+103.562d3;+109.660d3;+115.779d3;+121.917d3;+128.073d3;+134.246d3;+140.433d3;+146.636d3;+152.852d3;+159.081d3;+165.321d3;+171.573d3;+177.863d3;+184.109d3;+190.393d3;+196.686d3;+202.989d3;+209.301d3;+215.622d3;+221.951d3;+228.290d3;+234.637d3;+240.991d3;+247.354d3;+253.725d3;+260.103d3;+266.489d3;+272.882d3;+279.283d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;179.009d0;199.975d0;214.025d0;225.314d0;234.901d0;243.283d0;250.750d0;257.494d0;263.645d0;269.299d0;274.528d0;279.390d0;283.932d0;288.191d0;292.199d0;295.983d0;299.566d0;302.968d0;306.205d0;309.293d0;312.244d0;315.070d0;317.781d0;320.385d0;322.890d0;325.305d0;327.634d0;329.885d0;332.061d0;334.169d0;336.211d0;338.192d0;340.116d0;341.986d0;343.804d0;345.574d0;347.299d0;348.979d0;350.619d0;352.219d0;353.782d0;355.310d0;356.803d0;358.264d0;359.694d0;361.094d0;362.466d0;363.810d0;365.128d0;366.422d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="h">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.001007970000d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="216.000d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="9.50444d-6" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.72d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.6197427891d+04;-.4118800391d+04;-.2040172891d+04;0.3845460875d+02;0.2117082109d+04;0.4195709609d+04;0.6274337109d+04;0.8352964609d+04;0.1043159211d+05;0.1251021961d+05;0.1458884711d+05;0.1666747461d+05;0.1874610211d+05;0.2082472961d+05;0.2290335711d+05;0.2498198461d+05;0.2706061211d+05;0.2913923961d+05;0.3121786711d+05;0.3329649461d+05;0.3537512211d+05;0.3745374961d+05;0.3953237711d+05;0.4161100461d+05;0.4368963211d+05;0.4576825961d+05;0.4784688711d+05;0.4992551461d+05;0.5200414211d+05;0.5408276961d+05;0.5616139711d+05;0.5824002461d+05;0.6031865211d+05;0.6239727961d+05;0.6447590711d+05;0.6655453461d+05;0.6863316211d+05;0.7071178961d+05;0.7279041711d+05;0.7486904461d+05;0.7694767211d+05;0.7902629961d+05;0.8110492711d+05;0.8318355461d+05;0.8526218211d+05;0.8734080961d+05;0.8941943711d+05;0.9149806461d+05;0.9357669211d+05;0.9565531961d+05;0.9773394711d+05" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.9189868152d+02;0.1063066294d+03;0.1147347387d+03;0.1207145773d+03;0.1253529006d+03;0.1291426866d+03;0.1323469050d+03;0.1351225253d+03;0.1375707958d+03;0.1397608485d+03;0.1417419921d+03;0.1435506345d+03;0.1452144242d+03;0.1467548529d+03;0.1481889577d+03;0.1495304732d+03;0.1507906332d+03;0.1519787437d+03;0.1531025999d+03;0.1541687964d+03;0.1551829622d+03;0.1561499400d+03;0.1570739266d+03;0.1579585824d+03;0.1588071196d+03;0.1596223721d+03;0.1604068530d+03;0.1611628008d+03;0.1618922186d+03;0.1625969056d+03;0.1632784839d+03;0.1639384211d+03;0.1645780492d+03;0.1651985811d+03;0.1658011240d+03;0.1663866916d+03;0.1669562143d+03;0.1675105478d+03;0.1680504814d+03;0.1685767443d+03;0.1690900117d+03;0.1695909101d+03;0.1700800215d+03;0.1705578879d+03;0.1710250149d+03;0.1714818745d+03;0.1719289084d+03;0.1723665303d+03;0.1727951285d+03;0.1732150675d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="h2">
+      <info default="yes" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.00201588d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="8.99991d-6" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.001d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-008.467d3;-005.468d3;-002.774d3;+000.053d3;+002.959d3;+005.882d3;+008.811d3;+011.749d3;+014.702d3;+017.676d3;+020.680d3;+023.719d3;+026.797d3;+029.918d3;+033.082d3;+036.290d3;+039.541d3;+042.835d3;+046.169d3;+049.541d3;+052.951d3;+056.397d3;+059.876d3;+063.387d3;+066.928d3;+070.498d3;+074.096d3;+077.720d3;+081.369d3;+085.043d3;+088.740d3;+092.460d3;+096.202d3;+099.966d3;+103.750d3;+107.555d3;+111.380d3;+115.224d3;+119.086d3;+122.972d3;+126.874d3;+130.795d3;+134.734d3;+138.692d3;+142.667d3;+146.660d3;+150.670d3;+154.698d3;+158.741d3;+162.801d3;+166.876d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;100.727d0;119.412d0;130.858d0;139.216d0;145.737d0;151.077d0;155.606d0;159.548d0;163.051d0;166.216d0;169.112d0;171.790d0;174.288d0;176.633d0;178.846d0;180.944d0;182.940d0;184.846d0;186.669d0;188.418d0;190.099d0;191.718d0;193.278d0;194.785d0;196.243d0;197.654d0;199.021d0;200.349d0;201.638d0;202.891d0;204.111d0;205.299d0;206.457d0;207.587d0;208.690d0;209.767d0;210.821d0;211.851d0;212.860d0;213.848d0;214.816d0;215.765d0;216.696d0;217.610d0;218.508d0;219.389d0;220.255d0;221.106d0;221.943d0;222.767d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="o">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.01599940000d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="246.800d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="2.48572d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.66d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-.6851754462d+04;-.4463663519d+04;-.2175989025d+04;0.4050470042d+02;0.2208609989d+04;0.4345452201d+04;0.6463266114d+04;0.8570172296d+04;0.1067095349d+05;0.1276783101d+05;0.1486124109d+05;0.1695190011d+05;0.1904086885d+05;0.2112831240d+05;0.2321439477d+05;0.2529929132d+05;0.2738318792d+05;0.2946628007d+05;0.3154877204d+05;0.3363087595d+05;0.3571281098d+05;0.3779480243d+05;0.3987708086d+05;0.4195988125d+05;0.4404344210d+05;0.4612800456d+05;0.4821381158d+05;0.5030110701d+05;0.5239013474d+05;0.5448113785d+05;0.5657435768d+05;0.5867003304d+05;0.6076839927d+05;0.6286968738d+05;0.6497412324d+05;0.6708192660d+05;0.6919331033d+05;0.7130847946d+05;0.7342763036d+05;0.7555094985d+05;0.7767861435d+05;0.7981078896d+05;0.8194762663d+05;0.8408926730d+05;0.8623583696d+05;0.8838744686d+05;0.9054419258d+05;0.9270615321d+05;0.9487339042d+05;0.9704594762d+05;0.9922384909d+05" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="0.0000000000d+00;0.1361963410d+03;0.1520871407d+03;0.1610823078d+03;0.1673222456d+03;0.1720914832d+03;0.1759531114d+03;0.1792010799d+03;0.1820063510d+03;0.1844761567d+03;0.1866818180d+03;0.1886744406d+03;0.1904920911d+03;0.1921629452d+03;0.1937089044d+03;0.1951473387d+03;0.1964922579d+03;0.1977551268d+03;0.1989454475d+03;0.2000711839d+03;0.2011390771d+03;0.2021548838d+03;0.2031235594d+03;0.2040493998d+03;0.2049361539d+03;0.2057871123d+03;0.2066051790d+03;0.2073929292d+03;0.2081526573d+03;0.2088864158d+03;0.2095960475d+03;0.2102832135d+03;0.2109494151d+03;0.2115960139d+03;0.2122242479d+03;0.2128352458d+03;0.2134300386d+03;0.2140095709d+03;0.2145747088d+03;0.2151262490d+03;0.2156649247d+03;0.2161914119d+03;0.2167063352d+03;0.2172102717d+03;0.2177037555d+03;0.2181872815d+03;0.2186613086d+03;0.2191262623d+03;0.2195825376d+03;0.2200305015d+03;0.2204704948d+03" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="o2">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0319988d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="2.06302d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.69d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-008.683d3;-005.779d3;-002.868d3;+000.054d3;+003.025d3;+006.084d3;+009.244d3;+012.499d3;+015.835d3;+019.241d3;+022.703d3;+026.212d3;+029.761d3;+033.344d3;+036.957d3;+040.599d3;+044.266d3;+047.958d3;+051.673d3;+055.413d3;+059.175d3;+062.961d3;+066.769d3;+070.600d3;+074.453d3;+078.328d3;+082.224d3;+086.141d3;+090.079d3;+094.036d3;+098.013d3;+102.009d3;+106.023d3;+110.054d3;+114.102d3;+118.165d3;+122.245d3;+126.339d3;+130.447d3;+134.569d3;+138.705d3;+142.854d3;+147.015d3;+151.188d3;+155.374d3;+159.572d3;+163.783d3;+168.005d3;+172.240d3;+176.488d3;+180.749d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;173.307d0;193.485d0;205.329d0;213.871d0;220.693d0;226.451d0;231.466d0;235.921d0;239.931d0;243.578d0;246.922d0;250.010d0;252.878d0;255.556d0;258.068d0;260.434d0;262.672d0;264.796d0;266.818d0;268.748d0;270.595d0;272.366d0;274.069d0;275.709d0;277.290d0;278.819d0;280.297d0;281.729d0;283.118d0;284.466d0;285.776d0;287.050d0;288.291d0;289.499d0;290.677d0;291.826d0;292.949d0;294.044d0;295.115d0;296.162d0;297.186d0;298.189d0;299.171d0;300.133d0;301.076d0;302.002d0;302.910d0;303.801d0;304.677d0;305.538d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="oh">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.1700734d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="38.390d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="2.56282d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.66d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-009.172d3;-006.139d3;-002.976d3;+000.055d3;+003.035d3;+005.992d3;+008.943d3;+011.902d3;+014.880d3;+017.888d3;+020.935d3;+024.024d3;+027.160d3;+030.342d3;+033.569d3;+036.839d3;+040.151d3;+043.502d3;+046.889d3;+050.310d3;+053.762d3;+057.243d3;+060.752d3;+064.285d3;+067.841d3;+071.419d3;+075.017d3;+078.633d3;+082.267d3;+085.918d3;+089.584d3;+093.265d3;+096.960d3;+100.667d3;+104.387d3;+108.119d3;+111.863d3;+115.617d3;+119.381d3;+123.155d3;+126.939d3;+130.732d3;+134.534d3;+138.345d3;+142.164d3;+145.991d3;+149.827d3;+153.670d3;+157.521d3;+161.380d3;+165.246d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;149.590d0;171.592d0;183.894d0;192.466d0;199.066d0;204.447d0;209.007d0;212.983d0;216.526d0;219.736d0;222.680d0;225.408d0;227.955d0;230.346d0;232.602d0;234.740d0;236.771d0;238.707d0;240.557d0;242.327d0;244.026d0;245.658d0;247.228d0;248.741d0;250.202d0;251.613d0;252.978d0;254.300d0;255.581d0;256.824d0;258.031d0;259.203d0;260.344d0;261.455d0;262.537d0;263.591d0;264.620d0;265.624d0;266.604d0;267.562d0;268.499d0;269.415d0;270.311d0;271.189d0;272.050d0;272.893d0;273.719d0;274.530d0;275.326d0;276.107d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="h2o">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0180153d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-238.922d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.00879d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="1.03d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-009.904d3;-006.615d3;-003.282d3;+000.062d3;+003.452d3;+006.925d3;+010.501d3;+014.192d3;+018.002d3;+021.938d3;+026.000d3;+030.191d3;+034.506d3;+038.942d3;+043.493d3;+048.151d3;+052.908d3;+057.758d3;+062.693d3;+067.706d3;+072.790d3;+077.941d3;+083.153d3;+088.421d3;+093.741d3;+099.108d3;+104.520d3;+109.973d3;+115.464d3;+120.990d3;+126.549d3;+132.139d3;+137.757d3;+143.403d3;+149.073d3;+154.768d3;+160.485d3;+166.222d3;+171.980d3;+177.757d3;+183.552d3;+189.363d3;+195.191d3;+201.034d3;+206.892d3;+212.764d3;+218.650d3;+224.548d3;+230.458d3;+236.380d3;+242.313d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;152.388d0;175.485d0;189.042d0;198.788d0;206.534d0;213.052d0;218.739d0;223.825d0;228.459d0;232.738d0;236.731d0;240.485d0;244.035d0;247.407d0;250.620d0;253.690d0;256.630d0;259.451d0;262.161d0;264.769d0;267.282d0;269.706d0;272.048d0;274.312d0;276.503d0;278.625d0;280.683d0;282.680d0;284.619d0;286.504d0;288.337d0;290.120d0;291.858d0;293.550d0;295.201d0;296.812d0;298.384d0;299.919d0;301.420d0;302.887d0;304.322d0;305.726d0;307.101d0;308.448d0;309.767d0;311.061d0;312.329d0;313.574d0;314.795d0;315.993d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="h2o_ifcm">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="2" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="1" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.0180153d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="-238.922d3" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.00879d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="1.03d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default="-009.904d3;-006.615d3;-003.282d3;+000.062d3;+003.452d3;+006.925d3;+010.501d3;+014.192d3;+018.002d3;+021.938d3;+026.000d3;+030.191d3;+034.506d3;+038.942d3;+043.493d3;+048.151d3;+052.908d3;+057.758d3;+062.693d3;+067.706d3;+072.790d3;+077.941d3;+083.153d3;+088.421d3;+093.741d3;+099.108d3;+104.520d3;+109.973d3;+115.464d3;+120.990d3;+126.549d3;+140.139d3;+166.757d3;+180.403d3;+193.073d3;+200.768d3;+230.485d3;+250.222d3;+260.980d3;+270.757d3;+280.552d3;+290.363d3;+300.191d3;+310.034d3;+320.892d3;+330.764d3;+340.650d3;+350.548d3;+360.458d3;+370.380d3;+380.313d3" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default="000.000d0;152.388d0;175.485d0;189.042d0;198.788d0;206.534d0;213.052d0;218.739d0;223.825d0;228.459d0;232.738d0;236.731d0;240.485d0;244.035d0;247.407d0;250.620d0;253.690d0;256.630d0;259.451d0;262.161d0;264.769d0;267.282d0;269.706d0;272.048d0;274.312d0;276.503d0;278.625d0;280.683d0;282.680d0;284.619d0;286.504d0;288.337d0;290.120d0;291.858d0;293.550d0;295.201d0;296.812d0;298.384d0;299.919d0;301.420d0;302.887d0;304.322d0;305.726d0;307.101d0;308.448d0;309.767d0;311.061d0;312.329d0;313.574d0;314.795d0;315.993d0" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="air">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="gaseous" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.02885066880d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="1.80953d-5" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="300.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.68d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.2902420168d+04;.5813420168d+04;.8726731092d+04;.1165507563d+05;.1462007563d+05;.1764026049d+05;.2072779830d+05;.2388448737d+05;.2710959661d+05;.3039623526d+05;.3373777307d+05;.3712878987d+05;.4056249575d+05;.4403331087d+05;.4753865540d+05;.5107294951d+05;.5463303354d+05;.5821690749d+05;.6182262177d+05;.6544796630d+05;.6909099151d+05;.7274969739d+05;.7642508393d+05;.8011378141d+05;.8381578981d+05;.8753089904d+05;.9125752929d+05;.9499489063d+05;.9874256289d+05;.1025007562d+06;.1062676805d+06;.1100439158d+06;.1138276721d+06;.1176205292d+06;.1214196973d+06;.1252271763d+06;.1290415460d+06;.1328620166d+06;.1366893779d+06;.1405228401d+06;.1443621930d+06;.1482072266d+06;.1520571510d+06;.1559137560d+06;.1597752518d+06;.1636418484d+06;.1675147056d+06;.1713918736d+06;.1752749324d+06;.1791638820d+06" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.4701380229d+01;.5283440511d+01;.5624262703d+01;.5867385881d+01;.6058363290d+01;.6217382278d+01;.6354876707d+01;.6476679453d+01;.6586396012d+01;.6686436395d+01;.6778465257d+01;.6863683681d+01;.6943086036d+01;.7017382944d+01;.7087222564d+01;.7153093398d+01;.7215426243d+01;.7274602881d+01;.7330903136d+01;.7384593386d+01;.7435933287d+01;.7485102665d+01;.7532288070d+01;.7577655882d+01;.7621299377d+01;.7663398380d+01;.7704025999d+01;.7743304360d+01;.7781320013d+01;.7818130661d+01;.7853822855d+01;.7888476425d+01;.7922133666d+01;.7954860964d+01;.7986700613d+01;.8017725721d+01;.8047934327d+01;.8077401499d+01;.8106131998d+01;.8134214338d+01;.8161610985d+01;.8188423895d+01;.8214608813d+01;.8240260975d+01;.8265364973d+01;.8289934254d+01;.8314028479d+01;.8337632243d+01;.8360803247d+01;.8383541490d+01" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="solid">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="solid" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="2700.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="glass">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="solid" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="2500.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.d0" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="dfl1">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="0" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="831.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="21.30d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="717.50d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="938.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.411930d+06;0.408550d+06;0.405170d+06;0.401790d+06;0.398410d+06;0.395030d+06;0.391650d+06;0.388270d+06;0.384890d+06;0.381510d+06;0.378130d+06;0.374750d+06;0.371370d+06;0.367990d+06;0.364610d+06;0.361230d+06;0.357850d+06;0.354470d+06;0.351090d+06;0.347710d+06;0.344330d+06;0.340950d+06;0.337570d+06;0.334190d+06;0.330810d+06;0.327430d+06;0.324050d+06;0.320670d+06;0.317290d+06;0.313910d+06;0.310560d+06;0.307230d+06;0.303930d+06;0.300640d+06;0.297360d+06;0.294090d+06;0.290830d+06;0.287570d+06;0.284310d+06;0.281040d+06;0.277760d+06;0.274450d+06;0.271120d+06;0.267760d+06;0.264350d+06;0.260890d+06;0.257360d+06;0.253760d+06;0.250070d+06;0.246280d+06;0.242380d+06;0.238340d+06;0.234150d+06;0.229790d+06;0.225240d+06;0.220480d+06;0.215480d+06;0.210210d+06;0.204640d+06;0.198730d+06;0.192420d+06;0.185680d+06;0.178430d+06;0.170580d+06;0.162050d+06;0.152670d+06;0.142280d+06;0.130600d+06;0.117220d+06;0.101410d+06;0.084300d+06;0.036129d+06;0.000000d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000001d+05;0.000002d+05;0.000006d+05;0.000015d+05;0.000034d+05;0.000072d+05;0.000145d+05;0.000281d+05;0.000522d+05;0.000934d+05;0.001615d+05;0.002706d+05;0.004406d+05;0.006986d+05;0.010812d+05;0.016362d+05;0.024254d+05;0.035269d+05;0.050380d+05;0.070782d+05;0.097920d+05;0.133523d+05;0.179633d+05;0.238635d+05;0.313288d+05;0.406749d+05;0.522607d+05;0.664898d+05;0.838132d+05;1.047310d+05;1.297940d+05;1.594160d+05;1.936600d+05;2.336580d+05;2.800980d+05;3.337120d+05;3.952740d+05;4.656000d+05;5.421980d+05;6.300110d+05;7.286190d+05;8.388990d+05;9.617550d+05;10.981100d+05;12.489300d+05;14.151600d+05;15.978100d+05;17.978700d+05;20.163600d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;3.340000d-03;3.340000d-03;3.340000d-03;3.340000d-03;3.340000d-03;3.340000d-03;2.780000d-03;2.220000d-03;1.820000d-03;1.510000d-03;1.280000d-03;1.090000d-03;0.947000d-03;0.830000d-03;0.734000d-03;0.655000d-03;0.589000d-03;0.533000d-03;0.485000d-03;0.445000d-03;0.410000d-03;0.379000d-03;0.352000d-03;0.329000d-03;0.308000d-03;0.289000d-03;0.273000d-03;0.258000d-03;0.245000d-03;0.233000d-03;0.222000d-03;0.212000d-03;0.203000d-03;0.194000d-03;0.186000d-03;0.179000d-03;0.173000d-03;0.167000d-03;0.161000d-03;0.156000d-03;0.151000d-03;0.146000d-03;0.142000d-03;0.138000d-03;0.134000d-03;0.131000d-03;0.128000d-03;0.124000d-03;0.122000d-03;0.119000d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+    <model layout="flat" name="c10h22">
+      <info default="no" name="species_is_fuel" type="string" visibility="hidden"/>
+      <info default="liquid" name="species_type" type="string" visibility="hidden"/>
+      <info default="10" name="species_c_atoms" type="string" visibility="hidden"/>
+      <info default="22" name="species_h_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_o_atoms" type="string" visibility="hidden"/>
+      <info default="0" name="species_n_atoms" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_molecular_weight" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_formation_enthalpy" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_molecular_viscosity" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_ref_temperature" type="string" visibility="hidden"/>
+      <info default="0.d0" name="species_power_law_exponent" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_enthalpy_table" type="string" visibility="hidden"/>
+      <info default=".0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00;.0000000000d+00" name="species_entropy_table" type="string" visibility="hidden"/>
+      <info default="699.d0" name="tpf_species_density" type="string" visibility="hidden"/>
+      <info default="18.60d-03" name="tpf_species_surface_tension" type="string" visibility="hidden"/>
+      <info default="617.70d0" name="tpf_species_tcrit" type="string" visibility="hidden"/>
+      <info default="624.00d-06" name="tpf_species_vcrit" type="string" visibility="hidden"/>
+      <info default="0.490000d+06;0.485500d+06;0.481000d+06;0.476500d+06;0.472000d+06;0.467500d+06;0.463000d+06;0.458500d+06;0.454000d+06;0.449500d+06;0.445000d+06;0.440500d+06;0.436000d+06;0.431500d+06;0.427000d+06;0.422500d+06;0.418000d+06;0.413500d+06;0.409000d+06;0.404500d+06;0.400000d+06;0.395500d+06;0.391000d+06;0.386500d+06;0.382000d+06;0.377500d+06;0.373000d+06;0.368500d+06;0.364000d+06;0.359500d+06;0.355000d+06;0.350000d+06;0.345000d+06;0.340000d+06;0.335000d+06;0.330000d+06;0.325000d+06;0.320000d+06;0.315000d+06;0.310000d+06;0.305000d+06;0.299000d+06;0.293000d+06;0.287000d+06;0.281000d+06;0.275000d+06;0.269000d+06;0.263000d+06;0.257000d+06;0.251000d+06;0.245000d+06;0.234140d+06;0.223290d+06;0.212430d+06;0.201570d+06;0.190720d+06;0.179860d+06;0.169000d+06;0.158150d+06;0.147290d+06;0.117000d+06;0.051637d+06;0.000000d+06" name="tpf_species_hlat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000180d+05;0.000430d+05;0.000900d+05;0.001880d+05;0.003700d+05;0.006750d+05;0.012100d+05;0.020900d+05;0.034000d+05;0.053000d+05;0.081000d+05;0.127000d+05;0.177000d+05;0.248000d+05;0.350000d+05;0.485000d+05;0.645000d+05;0.840000d+05;1.090000d+05;1.380000d+05;1.720000d+05;2.130000d+05;2.650000d+05;3.240000d+05;3.920000d+05;4.750000d+05;5.750000d+05;6.800000d+05;8.000000d+05;9.400000d+05;11.000000d+05;12.700000d+05;14.700000d+05;16.800000d+05;19.100000d+05;21.200000d+05" name="tpf_species_psat" type="string" visibility="hidden"/>
+      <info default="0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;0.000000d+05;2.430000d-03;2.430000d-03;2.060000d-03;1.650000d-03;1.350000d-03;1.120000d-03;0.953000d-03;0.819000d-03;0.712000d-03;0.626000d-03;0.556000d-03;0.497000d-03;0.448000d-03;0.406000d-03;0.370000d-03;0.339000d-03;0.312000d-03;0.287000d-03;0.266000d-03;0.246000d-03;0.228000d-03;0.212000d-03;0.197000d-03;0.183000d-03;0.170000d-03;0.159000d-03;0.147000d-03;0.137000d-03;0.127000d-03;0.118000d-03;0.109000d-03;0.101000d-03;0.093200d-03;0.085900d-03;0.079100d-03;0.072600d-03;0.066500d-03;0.060800d-03;0.055300d-03;0.050300d-03" name="tpf_species_viscosity" type="string" visibility="hidden"/>
+    </model>
+  </model>
+</model>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_corail_ssh.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_corail_ssh.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_corail_ssh.xml	(revision 4775)
@@ -0,0 +1,18 @@
+<model name="cerfacs_corail_ssh" title="Cerfacs, code execution on CORAIL" >
+    <param name="login" title="Login" type="ascii" default="mylogin"/>
+    <param name="directory" title="Distant directory" type="ascii" default="/lustre/cfd/mylogin" />
+    <param name="nbprocs" title="Procs number" type="integer" default="24"/>
+    <param name="jobname" title="Job name" type="string_strmax10" default="C3Sm_job" />
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on CORAIL from an external computer, or from the Cerfacs NFS system.
+        []
+        On a production run, you can request a maximum of 192 processes (8 nodes , 24 procs each)
+        []
+        Check that you can log on the distant machine without password!!!
+        []
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_formation_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_formation_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_formation_local.xml	(revision 4775)
@@ -0,0 +1,12 @@
+<model name="cerfacs_formation_local" title="Cerfacs, formation room" >
+  <param name="nbprocs" title="Procs number" type="integer_ge1_le8" default="2" />
+  <param name="login" title="login" type="string" default="form01" />
+<desc>
+Execution at Cerfacs, in the formation room
+for form_XX
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=cerfacs;caption=Cerfacs only]</desc>
+
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_local.xml	(revision 4775)
@@ -0,0 +1,26 @@
+<model name="cerfacs_neptune_local" title="Cerfacs, code execution on NEPTUNE (LOCAL)" >
+    <choice name="nbtasks" title="Number of tasks" default="sixteen">
+        <option value="one" title="1 node, 1 core"/>
+        <option value="two" title="1 node, 2 cores"/>
+        <option value="four" title="1 node, 4 cores"/>
+        <option value="eight" title="1 node, 8 cores"/>
+        <option value="sixteen" title="1 node, 16 cores"/>
+        <option value="thirtytwo" title="2 nodes, 32 cores"/>
+        <option value="sixtyfour" title="4 nodes, 64 cores"/>
+        <option value="onehundredtwentyeight" title="8 nodes, 128 cores"/>
+    </choice>
+    <param name="nbnodes" title="Number of nodes" type="integer" default="16" />
+    <param name="jobname" title="Job name" type="string_strmax10" default="C3Sm_job" />
+    
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on NEPTUNE from NEPTUNE.
+        []
+        On a production run, you can request a maximum of 128 cores (8 nodes , 16 cores each)
+        []
+        
+        [logo=plugin_local;caption=local execution ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_ssh.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_ssh.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/cerfacs_neptune_ssh.xml	(revision 4775)
@@ -0,0 +1,29 @@
+<model name="cerfacs_neptune_ssh" title="Cerfacs, code execution on NEPTUNE (DISTANT)" >
+    <param name="login" title="Login" type="ascii" default="mylogin"/>
+    <param name="directory" title="Distant directory" type="ascii" default="/scratch/cfd/mylogin" />
+    <choice name="nbtasks" title="Number of tasks" default="sixteen">
+        <option value="one" title="1 node, 1 core"/>
+        <option value="two" title="1 node, 2 cores"/>
+        <option value="four" title="1 node, 4 cores"/>
+        <option value="eight" title="1 node, 8 cores"/>
+        <option value="sixteen" title="1 node, 16 cores"/>
+        <option value="thirtytwo" title="2 nodes, 32 cores"/>
+        <option value="sixtyfour" title="4 nodes, 64 cores"/>
+        <option value="onehundredtwentyeight" title="8 nodes, 128 cores"/>
+    </choice>
+    <param name="nbnodes" title="Number of nodes" type="integer" default="16" />
+    <param name="jobname" title="Job name" type="string_strmax10" default="C3Sm_job" />
+    
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on NEPTUNE from an external computer, or from the Cerfacs NFS system.
+        []
+        On a production run, you can request a maximum of 128 cores (8 nodes , 16 cores each)
+        []
+        Check that you can log on the distant machine without password!!!
+        
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/coria_anymachine_ssh.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/coria_anymachine_ssh.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/coria_anymachine_ssh.xml	(revision 4775)
@@ -0,0 +1,14 @@
+<model name="coria_anymachine_ssh" title="Coria, Code execution on any ssh machine" >
+    <param name="login" title="Login" type="ascii"  default="login"/>
+    <param name="machine" title="Machine" type="ascii" default="cobra" />
+    <param name="directory" title="working directory" type="ascii" default="~" />
+    <param name="nbprocs" title="Procs number" type="integer" default="1" />
+    <desc>
+        This plugin is for Coria only
+         Check that you can log on the distant machnine without password!!!
+[]
+[logo=plugin_ssh;caption=execution through ssh ]
+[]
+[logo=coria;caption=Coria only]
+</desc>
+    </model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/distant_unix.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/distant_unix.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/distant_unix.xml	(revision 4775)
@@ -0,0 +1,15 @@
+<model name="distant_unix" title="Cerfacs, Code execution from External to NFS network" >
+    <param name="login" title="Login" type="ascii"  default="login"/>
+    <param name="machine" title="Machine" type="ascii" default="cobra" />
+    <param name="directory" title="working directory" type="ascii" default="/wkdir/cfd1/mylogin" />
+    <info name="nbprocs" title="Procs number" type="integer" default="1" />
+    <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code from an external computer, typically a mac, or any computer NOT on the NFS system.
+         Check that you can log on the distant machnine without password!!!
+[]
+[logo=plugin_ssh;caption=execution through ssh ]
+[]
+[logo=cerfacs;caption=Cerfacs only]
+</desc>
+    </model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/folderParameters.xml	(revision 4775)
@@ -0,0 +1,1 @@
+<xor name="code_plugins" title="Code execution"  default="no_plugin" groups="on" />
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/local_unix.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/local_unix.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/local_unix.xml	(revision 4775)
@@ -0,0 +1,10 @@
+<model name="local_unix" title="Cerfacs, codes on NFS network" >
+<param name="nbprocs" title="Procs number" type="integer" default="1" />
+<desc>
+Execution at Cerfacs, on the NFS network.
+Works for cobra, ptero , babylon, etc...
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=cerfacs;caption=Cerfacs only]</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/no_plugin.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/no_plugin.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/no_plugin.xml	(revision 4775)
@@ -0,0 +1,6 @@
+<model name="no_plugin" title="No plugin" >
+<desc>
+No plug-in selected for codes.
+[logo=plugin_missing]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/snecma_runappli.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/snecma_runappli.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/snecma_runappli.xml	(revision 4775)
@@ -0,0 +1,27 @@
+<model name="snecma_runappli" title="Snecma, code execution by Runappli" >
+    <choice name="version_ra" title ="Version de Runappli" default="simu#V04R02" >
+        <option value="simu#V04R02" title="Simu/V04R02" />
+        <option value="oper#V04R02" title="Oper/V04R02" />
+        <option value="simu#V04R03" title="Simu/V04R03" />
+        <option value="oper#V04R03" title="Oper/V04R03" />
+    </choice>
+    <choice name="platform" title="Plateforme" default="airain" >
+        <option value="zephyr" />
+        <option value="curie" />
+        <option value="airain" />
+    </choice>
+    <param name="duration" title="Duree (sec.)" type="integer_ge500" default="500"/>
+    <param name="memory" title="Memoire (Mo)" type="integer_ge240" default="240"/>
+    <param name="nbprocs" title="Nombre de procs" type="integer_ge1" default="1" />
+    <param name="noclean" title="Conserver le rep; apres calcul" type="onoff" default="0" />
+    <desc>
+	Ce profil est a l'usage de Safran Villaroche.
+	[]
+	Il permet de lancer des jobs sur le CCRT et sur le cluster local Zephyr, au travers de la passerelle Runappli.
+	Il n'est pas necessaire d'utiliser Taucade.
+	[]
+[logo=plugin_robot;caption=execution par robot]
+[]
+[logo=snecma;caption=Uniquement pour Snecma]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_local.xml	(revision 4775)
@@ -0,0 +1,9 @@
+<model name="turbomeca_btmclx2_local" title="Turbomeca, codes on BTMCLX2" >
+<param name="nbprocs" title="Procs number" type="integer" default="1" />
+<desc>
+Execution at Turbomeca, on the cluster BTMCLX2
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=turbomeca;caption=Turbomeca only]</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_soumi.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_soumi.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_btmclx2_soumi.xml	(revision 4775)
@@ -0,0 +1,18 @@
+<model name="turbomeca_btmclx2_soumi" title="Turbomeca, code execution by soumi on BTMCLX2" >
+    <param name="external" title="Exterieur a TM" type="onoff" default="0"/>
+    <param name="duration" title="Duree (HH)" type="integer" default="02"/>
+    <param name="memory" title="Memoire (1G,3k...)" type="ascii" default="1G"/>
+    <param name="nbprocs" title="Procs number" type="integer" default="1" />
+    <param name="directory" title="working directory" type="ascii" default="~" />
+    <desc>
+	(note de A Dauptain : en relisant rapidement, il me semble qiue la mise a jour Yales a rendu inoperant le lancement d'AVSP. A reverifier par T Lederlin... )
+	Ce profil est a l'usage de Safran Turbomeca.
+	[]
+	Il permet de lancer des jobs sur le cluster BTMCLX2, au travers de l'outil SOUMI.
+	Il n'est pas necessaire d'utiliser Taucade.
+	[]
+        [logo=plugin_robot;caption=execution par robot]
+        []
+        [logo=turbomeca;caption=Uniquement pour Turbomeca]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_ccrt_ssh.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_ccrt_ssh.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/turbomeca_ccrt_ssh.xml	(revision 4775)
@@ -0,0 +1,22 @@
+<model name="turbomeca_ccrt_ssh" title="Turbomeca, code execution by SSH to CCRT" >
+    <choice name="machinecea" default="curie" >
+        <option value="curie" />
+        <option value="airain" />
+    </choice>
+    <param name="login" title="Login" type="ascii" default="login"/>
+    <param name="nbprocs" title="Procs number" type="integer" default="1" />
+    <param name="timelimit" title="Time limit (s)" type="integer" default="70000" /> 
+    <param name="mail" title="Your e-mail" type="ascii"/>
+    <param name="distantdir" title="Distant directory" type="ascii" />
+     <desc>
+        []
+        This plugin is for Turbomeca only
+        It allows to execute a code on a CCRT from BTMCLX2
+        []
+        Check that you can log on the distant machine without password!!!
+        []
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=turbomeca;caption=Turbomeca only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_corail.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_corail.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_corail.xml	(revision 4775)
@@ -0,0 +1,17 @@
+<model name="unix_corail" title="Cerfacs, code execution by SSH to CORAIL" >
+    <param name="login" title="Login" type="ascii" default="mylogin"/>
+    <param name="directory" title="Distant directory" type="ascii" default="/lustre/cfd/mylogin" />
+    <param name="nbprocs" title="Procs number" type="integer" default="24"/>
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on CORAIL from an external computer, or from the Cerfacs NFS system.
+        []
+        On a production run, you can request a maximum of 192 processes (8 nodes , 24 procs each)
+        []
+        Check that you can log on the distant machine without password!!!
+        []
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_curie.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_curie.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_curie.xml	(revision 4775)
@@ -0,0 +1,20 @@
+<model name="unix_curie" title="Cerfacs, code execution by SSH to CCRT" >
+    <choice name="machinecea" default="curie" >
+        <option value="curie" />
+        <option value="airain" />
+    </choice>
+    <param name="login" title="Login" type="ascii" />
+    <param name="nbprocs" title="Procs number" type="integer" default="1" />
+    <param name="timelimit" title="Time limit (s)" type="integer" default="3600" />
+    <param name="distantdir" title="Distant directory" type="ascii" />
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on a CCRT from an external computer, or from the Cerfacs NFS system.
+        []
+        Check that you can log on the distant machine without password!!!
+        []
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_neptune.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_neptune.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/code_plugins/unix_neptune.xml	(revision 4775)
@@ -0,0 +1,23 @@
+<model name="unix_neptune" title="Cerfacs, code execution by SSH to NEPTUNE" >
+    <param name="login" title="Login" type="ascii" default="login"/>
+    <param name="directory" title="Distant directory" type="ascii" default="/scratch/cfd/login" />
+    <param name="nbnodes" title="Number of nodes" type="integer" default="16" />
+    <!--<param name="nbcavbp" title="Number of AVBP cores" type="integer" default="16" existif="#avbpavtp# == {yes} || #avbpprissma# == {yes}"/>
+    <param name="nbcavtp" title="Number of AVTP cores" type="integer" default="1" existif="#avbpavtp# == {yes} || #avtpprissma# == {yes}"/>
+    <param name="nbprissma" title="Number of PRISSMA cores" type="integer" default="1" existif="#avbpprissma# == {yes} || #avtpprissma# == {yes}"/>-->
+    <param name="nbcavbp" title="Number of AVBP cores" type="integer" default="16" />
+    <param name="nbcavtp" title="Number of AVTP cores" type="integer" default="1" />
+    <param name="nbprissma" title="Number of PRISSMA cores" type="integer" default="1" />
+     <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a code on NEPTUNE from an external computer, or from the Cerfacs NFS system.
+        []
+        On a production run, you can request a maximum of 64 processes (8 nodes , 16 procs each)
+        []
+        Check that you can log on the distant machine without password!!!
+        
+        [logo=plugin_ssh;caption=execution through ssh ]
+        []
+        [logo=cerfacs;caption=Cerfacs only]
+    </desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_corail_ssh.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_corail_ssh.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_corail_ssh.py	(revision 4775)
@@ -0,0 +1,129 @@
+import os
+import shutil
+import XDR
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class cerfacs_corail_ssh(XDR.Plugin):
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        print "Using corail plugin, check in terminal if password is asked"
+        
+        self.login = self.getPluginParam("login")
+        self.machine = "corail"
+        self.nbprocs = self.getPluginParam("nbprocs")
+        self.jobname = self.getPluginParam("jobname").replace(" ","_")
+        self.dir2send = []
+        self.distantDirectory = self.getPluginParam("directory")
+        
+        
+        
+        
+        # create the DISTANT_UNIX_DIRECTORY on the distant machine
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+DISTANT_UNIX_DIRECTORY+""" ] ; then mkdir """+DISTANT_UNIX_DIRECTORY+""" ; fi" """
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY)
+        
+        # then create the project_name folder if needed
+        project_name = XDR.getValue("name","project","meta")
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+project_name+""" ] ; then mkdir """+project_name+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,project_name)
+    
+    
+    # Applications supported
+    @XDR.supported_applications(['avsp52','avbp621','avtp2'])
+    def executeDistantCommand(self,command,execDirectory,appli, flags=[]):       
+        
+        execDir_abspath = os.path.join(self.distantDirectory,execDirectory)
+        print "Running executeDistantCommand "+command+" in "+execDirectory+" for appli"+appli
+       
+        ########
+        # INITS
+        ########
+        command_exe = command
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+
+        # Creating batch file
+        batchContent = "#!/bin/bash \n"
+        batchContent += "#PBS -N C3Sm\n"
+        batchContent += "#PBS -j oe\n"
+        batchContent += "#PBS -l select=" + self.getPluginParam("nbprocs")+"\n"
+        batchContent += "#PBS -l walltime=06:00:00 \n"
+        batchContent += "cat $PBS_NODEFILE \n"
+        batchContent += "nb_cpu=$(wc -l < $PBS_NODEFILE)\n"
+        batchContent += "cd $PBS_O_WORKDIR\n"
+        batchContent += "source /usr/local/bin/intelmpi.sh\n"
+               
+############################################################################
+############################################################################
+############################################################################
+                    
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "/usr/local/bin/python /home/rolex/AVSP/avsp53/quiet3.py &> ./quiet.out"
+                avsp_command = "mpirun -np "+self.nbprocs+ " /home/rolex/AVSP/avsp53/AVSP_V5.3.CORAIL"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = "/home/rolex/AVSP/avsp53/Anozzle_CORAIL.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+                    
+        ########
+        # AVBP #
+        ########
+        if appli == "avbp621":
+            batchContent+="export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH\n"
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVBP_V6.X/AVBP_D6.2.1/AVBP_V6.2.1_beta.CORAIL > avbp_log.txt"
+                
+        ########
+        # AVTP #
+        ########
+        if appli == "avtp2":
+            if command == "-c3sm_auto_avtp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVTP/avtp2/AVTP_V2.X.CORAIL > avtp_log.txt"
+                
+############################################################################
+############################################################################
+############################################################################
+
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+        batchContent +=command_exe
+        
+        batchFile = open(os.path.join(XDR.getCurrentRun(), "batch_C3Sm_CORAIL"), 'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+
+        # create a zip archive of the directories list
+        print "Final composition of c3sm_archive:"
+        print self.dir2send
+        
+        XDR.ssh_send(self.machine,self.login, self.distantDirectory, self.dir2send, options="")   
+        
+        sshCommand = "cd {0}; /opt/pbs/default/bin/qsub batch_C3Sm_CORAIL".format(execDir_abspath)
+        XDR.ssh(self.machine,self.login, sshCommand, options="")
+       
+ 
+    def retrieveDirectory(self,directory):
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        XDR.ssh_retrieve(self.machine, self.login, self.distantDirectory+"/"+dist_directory, local_directory )
+
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+self.distantDirectory+"/.. "+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -rf "+self.distantDirectory+"/"+directory
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+    
+    def getRunsState(self):
+        pass
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_formation_local.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_formation_local.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_formation_local.py	(revision 4775)
@@ -0,0 +1,183 @@
+import os,XDR
+
+class cerfacs_formation_local(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        self.login = self.getPluginParam("login")
+        self.nbprocs = self.getPluginParam("nbprocs")
+       
+        if self.login not in ["form00","form01","form02","form03","form04","form05","form06","form07","form08","form09","form10","form11"] :
+	    error("Your login is not of the form 'formXX' with XX btw 01 and 11. Check your config file")
+    
+    def sendDirectory(self,directory):
+        
+        if os.path.exists(directory):
+            return 1
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+         ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        myhome = "/home/"+self.login
+
+        
+         #####################
+        # SECTION DEPENDING ON APPLICATIONS
+        ####################
+        supported_applis.append("tool_avsp52") 
+        supported_applis.append("avsp52") 
+        supported_applis.append("tool_avbp621") 
+        supported_applis.append("avbp621") 
+        supported_applis.append("tool_avtp2") 
+        supported_applis.append("hip_script") 
+        supported_applis.append("dummy")
+        
+        if appli not in supported_applis:
+            XDR.error("this application requires the application tag "+ appli+ ", which is not supported by the plugin cerfacs_formation_local.")
+
+        ########
+        # AVBP #
+        ########
+	if appli == "avbp621":
+            avbp_home = myhome+"/AVBP_V6.2"
+            command_exe ="mpiexec -boot -np 2 "+ avbp_home+"/HOST/FORMATION/AVBPEXEC/AVBP_V6.2.FORMATION > avbp_log.txt" 
+	if appli == "tool_avbp621":
+            hip_cur_version =  myhome+"/AVBP_V6.2/HOST/FORMATION/TOOLEXEC/hip-1.39.3-PCLINUX"
+            avbp_home = myhome+"/AVBP_V6.2"
+            avbp_scripts = os.path.join(avbp_home,"TOOLS","BIN","SCRIPTS")
+           
+            if command.startswith("-c3sm_auto_"):
+ 
+                #command_exe="source "+rolex_tag+" ; "
+                command_exe=""
+
+
+                if command.startswith("-c3sm_auto_loadmesh-"):
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_meshinfo-",os.path.join(avbp_scripts,"meshinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_get_patch_surf-",os.path.join(avbp_scripts,"get_patch_surf "))
+                    command_exe+= "/usr/bin/python ./script_mesh.py"
+            
+                if command.startswith("-c3sm_auto_track-"):
+                    command_exe += command.replace("-c3sm_auto_track-",os.path.join(avbp_scripts,"track "))
+                
+                if command.startswith("-c3sm_auto_tadia-"):
+                    command_exe += command.replace("-c3sm_auto_tadia-",os.path.join(avbp_scripts,"tadia "))
+                    
+                if command.startswith("-c3sm_auto_flame_param-"):
+                    command_exe += command.replace("-c3sm_auto_flame_param-",os.path.join(avbp_scripts,"flame_param "))
+                
+                if command == "-c3sm_auto_prepare_boundary-":
+                    print "my friend"
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_hip-",hip_cur_version)
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makesolutbound-",os.path.join(avbp_scripts,"makesolutbound "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_genprofile-",os.path.join(avbp_scripts,"genprofile2 "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makeinject-",os.path.join(avbp_scripts,"makeinject "))
+                    command_exe+= "/usr/bin/python ./script_boundaries.py"
+            
+                if command == "-c3sm_auto_initsol-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_solinfo-",os.path.join(avbp_scripts,"solinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_vortex-",os.path.join(avbp_scripts,"addvortex "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_makesolution-",os.path.join(avbp_scripts,"makesolution "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_spec-",os.path.join(avbp_scripts,"add_spec "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_init_spec-",os.path.join(avbp_scripts,"init_spec "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_gas_out-",os.path.join(avbp_scripts,"gas_out "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_tpf-",os.path.join(avbp_scripts,"add_tpf "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_fic-",os.path.join(avbp_scripts,"add_fic "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_check_perio-",os.path.join(avbp_scripts,"check_perio "))
+                    command_exe+= "/usr/bin/python ./script_init.py"
+                    
+                if command.startswith("-c3sm_auto_xtools-"):
+                    command_exe=command.replace("-c3sm_auto_xtools-","")
+                
+
+                    
+
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            hip_cur_version =  myhome+"/AVBP_V6.2/HOST/FORMATION/TOOLEXEC/hip-1.39.3-PCLINUX"
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            hip_cur_version =  myhome+"/AVBP_V6.2/HOST/FORMATION/TOOLEXEC/hip-1.39.3-PCLINUX"
+            command_exe = hip_cur_version + " < " + command
+
+            
+        ########
+        # AVSP #
+        ########
+	if appli == "avsp52":
+            command_exe = "/usr/bin/python /home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/quiet3.py &> quiet.out"
+            #avsp_command = "/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/AVSPEXEC/AVSP_V5.2.KALI"
+            from shutil import copy
+            copy("/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/AVSPEXEC/AVSP_V5.3.KALI", execDirectory)
+            avsp_command = "mpirun -np 2 ./AVSP_V5.3.KALI"
+            XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+            anozzle_command = "/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/TOOLEXEC/Anozzle_CORAIL.exe"
+            XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+        if appli == "tool_avsp52":
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = "/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/TOOLEXEC/preproc_mlpf_KALI.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = "/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/TOOLEXEC/avspinitsol_KALI.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = "/home/avbp_00/AVSP_FORMATION/QUIET_FORMATION/AVSP_HOME/HOST/KALI/TOOLEXEC/Zinn_nozzle_KALI.exe"
+
+        ########
+        # AVTP #
+        ########
+        if appli == "tool_avtp2":
+            hip_cur_version =  "/home/rolex/HIP/1.38.1/hip-1.38.1-KALI"
+            avtp_tag =  "/home/cfd1/avtp/avtp_tag"
+            avtp_home = "/home/cfd1/avtp/AVTP_V2.X"
+            avtp_scripts = os.path.join(avtp_home,"TOOLS","BIN","SCRIPTS")
+
+            if command.startswith("-c3sm_auto"):
+
+                command_exe ="source "+avtp_tag+";"
+
+                if command.startswith("-c3sm_auto_loadmesh-"):
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_meshinfo-",os.path.join(avtp_scripts,"meshinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_get_patch_surf-",os.path.join(avtp_scripts,"get_patch_surf "))
+                    command_exe = "/usr/bin/python ./script_mesh.py"
+
+                if command.startswith("-c3sm_auto_track-"):
+                    command_exe = command.replace("-c3sm_auto_track-",os.path.join(avtp_scripts,"track "))
+
+                if command == "-c3sm_auto_prepare_boundary-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_hip-",hip_cur_version)
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makesolutbound-",os.path.join(avtp_scripts,"makesolutbound "))
+                    command_exe = "/usr/bin/python ./script_boundaries.py"
+
+                if command == "-c3sm_auto_initsol-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_solinfo-",os.path.join(avtp_scripts,"solinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_makesolution-",os.path.join(avtp_scripts,"makesolution "))
+                    command_exe = "/usr/bin/python ./script_init.py"
+
+	
+        os.chdir(execDirectory)
+        XDR.execute(command_exe)
+        os.chdir(local_directory)
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
+    
+    def getInfos(self):
+        self.infos['platform']="UNIX"
+        self.infos['parallelCommand'] = "mpirun -np "+XDR.getValue("nbprocs","local_unix",self.type+"_plugins","config")+" "
+        return self.infos    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_local.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_local.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_local.py	(revision 4775)
@@ -0,0 +1,164 @@
+import os,XDR
+
+from plugin_avbp import plugin_avbp
+
+class cerfacs_neptune_local(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+    def sendDirectory(self,directory):
+        
+        if os.path.exists(directory):
+            return 1
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+         ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        
+ #####################
+        # SECTION DEPENDING ON APPLICATIONS
+        ####################
+        supported_applis.append("avbp621") 
+        supported_applis.append("tool_avsp52") 
+        supported_applis.append("tool_avbp621") 
+        supported_applis.append("tool_avtp2") 
+        supported_applis.append("hip_script")
+        supported_applis.append("hip_current")
+        supported_applis.append("dummy")
+        
+        if appli not in supported_applis:
+            XDR.error("this application requires the application tag "+ appli+ ", which is not supported by the plugin cerfacs_neptune_local.")
+
+        ########
+        # AVBP #
+        ########
+        if appli == "tool_avbp621":
+#               avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+               avbp_home = "/scratch/cfd/hannebiq/AVBP_D6.2.1"
+               hostname = "NEPTUNE"
+               hip_cur_version = " /home/cfd/avbp/HIP/1.40.1/hip-1.40.1-NEPTUNE"
+               pythonexec = "python"
+               avbptool = plugin_avbp(avbp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+               command_exe = avbptool.switch_avbp_tools(appli,command)    
+               
+               # Creating batch file
+               batchContent =  """#!/bin/bash
+               #PBS -N C3Sm_tools
+               #PBS -l walltime=00:30:00
+               #PBS -j oe
+               #PBS -l select=1:ncpus=1:mpiprocs=1 -l place=scatter
+               #PBS -m ae
+               #PBS -q debug
+               
+               cat \$PBS_NODEFILE
+               nb_cpu=\$(wc -l < \$PBS_NODEFILE)
+               
+                       
+               """                    
+               batchContent +="""export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH"""+"\n"
+               batchContent+="mpirun "+command_exe+"\n" 
+        
+        if appli == "avbp621":
+               avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+               command_exe = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1/AVBP_V6.2.1_beta.NEPTUNE > avbp_log.txt" 
+		
+               # Creating batch file
+               batchContent =  """#!/bin/bash
+               #PBS -N C3Smjob
+               #PBS -l walltime=06:00:00
+               #PBS -j oe
+               #PBS -l select="""+self.getPluginParam("nbnodes")+"""
+               #PBS -m ae
+               
+               cat \$PBS_NODEFILE
+               nb_cpu=\$(wc -l < \$PBS_NODEFILE)
+               
+                       
+               cd """+execDir_abspath+"""
+               """                    
+               batchContent +="""export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH"""+"\n"
+               batchContent+="mpirun "+command_exe+"\n" 
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            command_exe = hip_cur_version+" < " + command
+
+            
+         ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            hip_cur_version =  "/home/rolex/HIP/1.40.1/hip-1.40.1-KALI"
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = "/home/rolex/QUIET_5.3/AVSP_HOME/HOST/KALI/TOOLEXEC/preproc_mlpf_KALI.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = "/home/rolex/QUIET_5.3/AVSP_HOME/HOST/KALI/TOOLEXEC/avspinitsol_KALI.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = "/home/rolex/QUIET_5.3/AVSP_HOME/HOST/KALI/TOOLEXEC/Zinn_nozzle_KALI.exe"
+            if command == "-c3sm_auto_add_activflame-":
+                global2avsp_cmd = "/home/rolex/QUIET_5.3/AVSP_HOME/HOST/KALI/TOOLEXEC/global2avsp_KALI.exe"
+                hipscript_cmd = hip_cur_version + " < script_hip"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_active_flame.py"),"-c3sm_auto_global2avsp_exec-",global2avsp_cmd)
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_active_flame.py"),"-c3sm_auto_hipscript-",hipscript_cmd)
+                command_exe = "/usr/bin/python ./script_active_flame.py"
+            if command == "-c3sm_auto_avbp2avsp_exec-":
+                command_exe = "/home/rolex/QUIET_5.3/AVSP_HOME/HOST/KALI/TOOLEXEC/avbp2avsp_KALI.exe"
+
+        ########
+        # AVTP #
+        ########
+        if appli == "tool_avtp2":
+            hip_cur_version =  "/home/rolex/HIP/1.39.3/hip-1.39.3-KALI"
+            avtp_tag =  "/home/rolex/rolex_avtp_20"
+            avtp_home = "/home/rolex/AVTP/AVTP_V2.X"
+            avtp_scripts = os.path.join(avtp_home,"TOOLS","BIN","SCRIPTS")
+
+            if command.startswith("-c3sm_auto"):
+
+                command_exe="source "+avtp_tag+";"
+
+                if command.startswith("-c3sm_auto_loadmesh-"):
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_meshinfo-",os.path.join(avtp_scripts,"meshinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_get_patch_surf-",os.path.join(avtp_scripts,"get_patch_surf "))
+                    command_exe = "/usr/bin/python ./script_mesh.py"
+
+                if command.startswith("-c3sm_auto_track-"):
+                    command_exe = command.replace("-c3sm_auto_track-",os.path.join(avtp_scripts,"track "))
+
+                if command == "-c3sm_auto_prepare_boundary-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_hip-",hip_cur_version)
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makesolutbound-",os.path.join(avtp_scripts,"makesolutbound "))
+                    command_exe = "/usr/bin/python ./script_boundaries.py"
+
+                if command == "-c3sm_auto_initsol-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_solinfo-",os.path.join(avtp_scripts,"solinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_makesolution-",os.path.join(avtp_scripts,"makesolution "))
+                    command_exe = "/usr/bin/python ./script_init.py"
+        os.chdir(execDirectory)
+        output = XDR.execute(command_exe)
+        os.chdir(local_directory)
+        return output
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_ssh.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_ssh.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/cerfacs_neptune_ssh.py	(revision 4775)
@@ -0,0 +1,270 @@
+import os,XDR,shutil
+
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class cerfacs_neptune_ssh(XDR.Plugin):
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        print "Using  neptune plugin, check in terminal if password is asked"
+        
+        self.login = self.getPluginParam("login")
+        self.machine = "neptune"
+        self.nbtasks = self.getPluginParam("nbtasks")
+        
+        self.nbcores = "none"
+        if self.nbtasks == "one" :
+            self.nbnodes = "1"
+            self.nbcores = "1"
+            self.nbcores_per_node = "1"
+            
+        if self.nbtasks == "two" :
+            self.nbnodes = "1"
+            self.nbcores = "2"
+            self.nbcores_per_node = "2"
+            
+        if self.nbtasks == "four" :
+            self.nbnodes = "1"
+            self.nbcores = "4"
+            self.nbcores_per_node = "4"
+            
+        if self.nbtasks == "eight" :
+            self.nbnodes = "1"
+            self.nbcores = "8"
+            self.nbcores_per_node = "8"
+            
+        if self.nbtasks == "sixteen" :
+            self.nbnodes = "1"
+            self.nbcores = "16"
+            self.nbcores_per_node = "16"
+            
+        if self.nbtasks == "thirtytwo" :
+            self.nbnodes = "2"
+            self.nbcores = "32"
+            self.nbcores_per_node = "16"
+            
+        if self.nbtasks == "sixtyfour" :
+            self.nbnodes = "4"
+            self.nbcores = "64"
+            self.nbcores_per_node = "16"
+            
+        if self.nbtasks == "onehundredtwentyeight" :
+            self.nbnodes = "8"
+            self.nbcores = "128"
+            self.nbcores_per_node = "16"
+            
+       
+        if self.nbcores == "none":
+            msg_err = "Problem : option nbtasks ="+self.nbtasks+" not recognized in plugin neptune"
+            error(msg_err)
+            
+        
+        self.jobname = self.getPluginParam("jobname").replace(" ","_")
+        self.dir2send = []
+        self.distantDirectory = self.getPluginParam("directory")
+        
+        
+        
+        # create the DISTANT_UNIX_DIRECTORY on the distant machine
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+DISTANT_UNIX_DIRECTORY+""" ] ; then mkdir """+DISTANT_UNIX_DIRECTORY+""" ; fi" """
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY)
+        
+        # then create the project_name folder if needed
+        project_name = XDR.getValue("name","project","meta")
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+project_name+""" ] ; then mkdir """+project_name+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,project_name)
+        
+        
+        
+        
+        
+    @XDR.supported_applications(['avsp52','avbp621','avbp70','avtp2','aap','prissma'])
+    def executeDistantCommand(self,command,execDirectory,appli, flags=[]):       
+        
+        
+        execDir_abspath = os.path.join(self.distantDirectory,execDirectory)
+        print "Running executeDistantCommand "+command+" in "+execDirectory+" for appli"+appli
+        ########
+        # INITS
+        ########
+        command_exe = command
+        appli_keyword = "none"
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        #project_name = "NOM_PROJET"
+        
+        # Creating batch file
+        batchContent = "#!/bin/bash \n"
+        batchContent +="#PBS -N "+self.jobname+" \n"
+        batchContent +="#PBS -l walltime=06:00:00 \n"
+        batchContent +="#PBS -j oe \n"
+        batchContent +="#PBS -l select="+self.nbnodes+":mpiprocs="+self.nbcores_per_node+":ncpus="+self.nbcores_per_node+"\n"
+        batchContent +="#PBS -m ae \n"
+
+        batchContent +="cat $PBS_NODEFILE \n "
+        batchContent +="nb_cpu=$(wc -l < $PBS_NODEFILE)\n"
+
+        batchContent +="cd "+execDir_abspath+"\n"
+
+
+
+
+        # no modification before this line
+################################################################################################################################
+################################################################################################################################
+################################################################################################################################
+          
+                    
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            if command == "-c3sm_auto_avsp_exe-":
+                batchContent+="module load avsp \n"
+                command_exe = "cp /home/rolex/AVSP/avsp53/quiet3.py . ; /usr/bin/python ./quiet3.py &> ./quiet.out"
+                avsp_command = "mpirun -np "+self.nbcores+ " /home/rolex/AVSP/avsp53/AVSP_V5.3.NEPTUNE"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = "/home/rolex/AVSP/avsp53/Anozzle_NEPTUNE.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+                    
+        ########
+        # AVBP #
+        ########
+        if appli == "avbp621":
+            #batchContent.append("export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH")
+            batchContent +="export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH\n"
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVBP_V6.X/AVBP_D6.2.1/AVBP_V6.2.1_beta.NEPTUNE > avbp_log.txt"
+        if appli == "avbp70":        
+            batchContent +="export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH\n"
+            if command == "-c3sm_auto_avbp_exe-":
+                #command_exe = "mpirun -np $nb_cpu /home/rolex/AVBP_V6.X/AVBP_D7.0/AVBP_V7.0_beta.NEPTUNE > avbp_log.txt"
+                command_exe = "mpirun -np $nb_cpu /scratch/cfd/bonhomme/AVBP_D7.0/HOST/NEPTUNE/AVBPEXEC/AVBP_V7.0_beta.NEPTUNE > avbp_log.txt"
+
+
+        ########
+        # AVTP #
+        ########
+        if appli == "avtp2":
+            if command == "-c3sm_auto_avtp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVTP_V2.X/AVTP_V2.X.NEPTUNE > avtp_log.txt"
+
+        ###########
+        # prissma #
+        ###########
+        if appli == "prissma":
+            if command == "-c3sm_auto_prissma_exe-":
+                batchContent+="cp -r /home/rolex/PRISSMA/DATA/SPECTRAL . \n"
+                command_exe = "mpirun -np $nb_cpu /home/rolex/PRISSMA/mpiprissma_V3.0.e_NEPTUNE > prissma_log.txt"
+                
+                
+        #######
+        # AAP #
+        #######
+        if appli == "aap":
+            home_aap = "/home/rolex/AAP/"
+            batchContent +="module load compiler/intel mpi/intelmpi \n"
+            
+                
+            ###################
+            # AAP : AVBP-AVTP #
+            ###################
+            if command.startswith("-c3sm_auto_avbp_avtp_exe-") and len(command.split(" ")) == 3:
+                palm_main=home_aap+"AVBP_AVTP/"+"palm_main"
+                main_avtp=home_aap+"AVBP_AVTP/"+"main_avtp"
+                main_avbp=home_aap+"AVBP_AVTP/"+"main_avbp"
+                nb_cores_avbp =  command.split(" ")[1]
+                nb_cores_avtp =  command.split(" ")[2]
+                batchContent +="export NBPROC_main_avbp="+nb_cores_avbp+" \n"
+                batchContent +="export NBPROC_main_avtp="+nb_cores_avtp+" \n"
+                batchContent +="cp "+home_aap+"AVBP_AVTP/avbp_avtp.pil . \n"
+                command_exe = "mpirun -np 1 "+palm_main+" : -np $NBPROC_main_avtp "+main_avtp+" : -np $NBPROC_main_avbp "+main_avbp+" > cpl_log.txt"  
+        
+            ######################
+            # AAP : PRISSMA-AVBP #
+            ######################
+            
+            if command.startswith("-c3sm_auto_avbp_prissma_exe-")  and len(command.split(" ")) == 3:
+                palm_main=home_aap+"AVBP_PRISSMA/"+"palm_main"
+                main_prissma=home_aap+"AVBP_PRISSMA/"+"main_prissma"
+                main_avbp=home_aap+"AVBP_PRISSMA/"+"main_avbp"
+                nb_cores_avbp =  command.split(" ")[1]
+                nb_cores_prissma =  command.split(" ")[2]
+                batchContent +="export NBPROC_main_avbp="+nb_cores_avbp+" \n"
+                batchContent +="export NBPROC_main_prissma="+nb_cores_prissma+" \n"
+                batchContent +="cp "+home_aap+"AVBP_PRISSMA/avbp_prissma.pil . \n"
+                batchContent+="cp -r /home/rolex/PRISSMA/DATA/SPECTRAL ./PRISSMA01/ \n"
+                command_exe ="mpirun -np 1 "+palm_main+" : -np $NBPROC_main_prissma "+main_prissma+" : -np $NBPROC_main_avbp "+main_avbp+" > cpl_log.txt"  
+        
+            ###########################
+            # AAP : AVBP-AVTP-PRISSMA #
+            ###########################
+           
+            if command.startswith("-c3sm_auto_avbp_avtp_prissma_exe-")  and len(command.split(" ")) == 4 :
+                nb_cores_avbp =  command.split(" ")[1]
+                nb_cores_avtp =  command.split(" ")[2]
+                nb_cores_prissma =  command.split(" ")[3]
+                palm_main=home_aap+"AVBP_AVTP_PRISSMA/"+"palm_main"
+                main_prissma=home_aap+"AVBP_AVTP_PRISSMA/"+"main_prissma"
+                main_avbp=home_aap+"AVBP_AVTP_PRISSMA/"+"main_avbp"                
+                main_avtp=home_aap+"AVBP_AVTP_PRISSMA/"+"main_avtp"
+                batchContent +="cp "+home_aap+"AVBP_AVTP_PRISSMA/3codescoupling.pil . \n"
+                batchContent+="cp -r /home/rolex/PRISSMA/DATA/SPECTRAL ./PRISSMA01/ \n"
+                batchContent +="export NBPROC_main_avbp="+nb_cores_avbp+" \n"
+                batchContent +="export NBPROC_main_avtp="+nb_cores_avtp+" \n"
+                batchContent +="export NBPROC_main_prissma="+nb_cores_prissma+" \n"
+                command_exe ="mpirun -np 1 "+palm_main+" : -np $NBPROC_main_avtp "+main_avtp+" : -np $NBPROC_main_prissma "+main_prissma+" : -np $NBPROC_main_avbp "+main_avbp+" > cpl_log.txt" 
+
+       
+################################################################################################################################
+################################################################################################################################
+################################################################################################################################
+       # no modification after this line
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+        batchContent +=command_exe
+
+
+
+        batchFile = open(os.path.join(XDR.getCurrentRun(), "batch_C3Sm_NEPTUNE"), 'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+
+        # create a zip archive of the directories list
+        print "Final composition of c3sm_archive:"
+        print self.dir2send
+        
+        XDR.ssh_send(self.machine,self.login, self.distantDirectory, self.dir2send, options="")   
+        
+        sshCommand = "cd {0}; /opt/pbs/default/bin/qsub batch_C3Sm_NEPTUNE".format(execDir_abspath)
+        XDR.ssh(self.machine,self.login, sshCommand, options="")
+        
+        
+        
+    def retrieveDirectory(self,directory):
+        
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        # Retrieve Directory
+        shutil.rmtree(local_directory)
+        scpCommand = "scp -pr "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+    
+        XDR.execute(scpCommand)
+        
+        
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+self.distantDirectory+"/.. "+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -rf "+self.distantDirectory+"/"+directory
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/coria_anymachine_ssh.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/coria_anymachine_ssh.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/coria_anymachine_ssh.py	(revision 4775)
@@ -0,0 +1,98 @@
+import os,XDR,shutil
+
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class coria_anymachine_ssh(XDR.Plugin):
+    def __init__(self,typePlugin):
+
+		# Il ne faut surtout pas supprimer cette ligne
+		XDR.Plugin.__init__(self, typePlugin)
+		
+		self.login = self.getPluginParam("login")
+		self.machine = self.getPluginParam("machine")
+		self.nbprocs = self.getPluginParam("nbprocs")        
+		self.distantDirectory = self.getPluginParam("directory")
+		self.project_name = XDR.getValue("name","project","meta")
+		
+		self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY, self.project_name)         
+		
+		# create the DISTANT_UNIX_DIRECTORY on the distant machine
+		XDR.ssh_prepare_directory(self.machine, self.login, self.distantDirectory)
+        
+            
+    def sendDirectory(self,directory):
+
+        local_directory = os.path.abspath(directory)
+        
+        if os.path.exists(local_directory):
+            print "Plugin : distant_unix sending directory "+local_directory +" at "+  self.distantDirectory
+            
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        
+        XDR.execute("scp -r "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory)
+        
+        
+        
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):       
+		  
+		print "Plugin : Running executeDistantCommand "+command+" in "+execDirectory+"("+appli+")"
+		
+		dist_path = os.path.join(self.distantDirectory,execDirectory)
+		script_path = XDR.getScriptDir()
+				
+		if command == "-c3sm_YALES2_auto_exe-":
+		
+			# Copy template batch file
+			batch_template_path = os.path.join(script_path,"batch_distant")
+			shutil.copy(batch_template_path,execDirectory)			
+			# Replace pattern in local copy of the template
+			batch_local_path = os.path.join(execDirectory,"batch_distant")
+			XDR.replace_pattern_in_file(batch_local_path,"nbprocs",self.nbprocs)						
+			# Send batch file      		
+			XDR.execute("scp -r "+batch_local_path+" "+self.login+"@"+self.machine+":"+dist_path)			
+			# Prepare command		        
+			sshCommand = "cd "+dist_path+"; chmod +x ./batch_distant ; /bin/bash -i ./batch_distant"
+		
+		
+		elif command == "-load_chemtable-":
+						
+			table_path_local=XDR.getValue("table",XDR.getValue("eos","chemistry"),"eos","chemistry")
+			dist_path=os.path.join(self.distantDirectory,execDirectory)+'/'
+			# Replace pattern + Send batch
+			XDR.replace_pattern_in_file(os.path.join(execDirectory,"batch_chemtable"),"-table_path-",dist_path)	
+			XDR.execute("scp -r "+execDirectory+" "+self.login+"@"+self.machine+":"+dist_path)	
+			# Send table      		
+			XDR.execute("scp -r "+table_path_local+" "+self.login+"@"+self.machine+":"+dist_path)					
+			# Prepare command
+			sshCommand = "cd "+dist_path+"; chmod +x ./batch_chemtable ; /bin/bash -i ./batch_chemtable"
+			
+		else:
+			XDR.error("Command unknown")
+		
+		
+		# Execute final command
+		
+		XDR.execute("ssh "+self.login+"@"+self.machine+" "+sshCommand)	
+		
+		
+    def retrieveDirectory(self,directory):
+    
+		distant_directory = os.path.join(self.distantDirectory,directory)
+		own_path = os.getcwd()
+		XDR.execute("scp -r "+self.login+"@"+self.machine+":"+distant_directory+" "+own_path)
+		
+		
+    def removeDirectory(self,directory):
+    
+    	distant_directory = os.path.join(self.distantDirectory,directory)
+    	XDR.execute("ssh "+self.login+"@"+self.machine+" if [ -d "+distant_directory+" ]; then rm -rf "+distant_directory+" ; else echo Directory missing ; fi" )
+        
+    
+    
+    def getInfos(self):
+    	self.infos['Name']= "coria_anymachine_ssh"
+        self.infos['platform']="UNIX"
+        self.infos['parallelCommand'] = "mpirun -np "+self.nbprocs
+        return self.infos
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/distant_unix.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/distant_unix.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/distant_unix.py	(revision 4775)
@@ -0,0 +1,242 @@
+import os,XDR,shutil
+
+from avbp import plugin_avbp
+from avtp import plugin_avtp
+from avsp import plugin_avsp
+from prissma import plugin_prissma
+
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class distant_unix(XDR.Plugin):
+    def __init__(self,typePlugin):
+        """ This method built a new instance of plugin.
+        First it constructs the plugin thanks to mother class : XDR.Plugin"""
+        # Il ne faut surtout pas supprimer cette ligne
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        
+        self.login = self.getPluginParam("login")
+        self.machine = self.getPluginParam("machine")
+        self.distantDirectory = self.getPluginParam("directory")
+        self.dir2send = []
+        
+        
+        # test connexion
+        sshCommand = 'echo "Ssh connection is ok..." '
+        print "Running command : "+sshCommand
+        test = XDR.ssh(self.machine,self.login, sshCommand, options=" -qo PasswordAuthentication=no")
+    
+        # create the DISTANT_UNIX_DIRECTORY on the distant machine
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+DISTANT_UNIX_DIRECTORY+""" ] ; then mkdir """+DISTANT_UNIX_DIRECTORY+""" ; fi" """
+        #XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        XDR.ssh(self.machine,self.login, sshCommand, options="")
+    
+    
+        self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY)
+        
+        # then create the project_name folder if needed
+        project_name = XDR.getValue("name","project","meta")
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+project_name+""" ] ; then mkdir """+project_name+""" ; fi" """    
+        XDR.ssh(self.machine,self.login, sshCommand, options="")
+    
+           
+        self.distantDirectory = os.path.join(self.distantDirectory,project_name)
+        
+        
+    
+    #def sendDirectory(self,directory):
+    #
+    #    local_directory = os.path.abspath(directory)
+    #    directory_basename = os.path.basename(local_directory)
+    #    
+    #    if os.path.exists(local_directory):
+    #        pass
+    #    else:
+    #        raise Exception("Error : "+directory+" doesn't exist")
+    #    
+    #    self.dir2send.append(directory)
+    #    print "Adding "+directory +" to the list of folders for the archive"
+    #    print self.dir2send
+    #    
+    #    #local_directory = os.path.abspath(directory)
+    #    #dist_directory = os.path.basename(local_directory)
+    #    #
+    #    #if os.path.exists(local_directory):
+    #    #    print "Plugin : distant_unix sending directory "+local_directory +" at "+  self.distantDirectory
+    #    #    
+    #    #else:
+    #    #    raise Exception("Error : "+directory+" doesn't exist")
+    #    #
+    #    #
+    #    #XDR.execute("scp -r "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory+"/")
+    #    ##XDR.execute("rsync -a "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory)
+    
+    
+    
+    @XDR.supported_applications(['tool_avsp52','tool_avbp621','tool_avtp2','tool_icritles','tool_prissma','projeteur','projeteur','hip_current','hip_script','mps_script','coolant','dummy'])
+        
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):       
+        
+        print "Plugin : Running executeDistantCommand "+command+" in "+execDirectory+"("+appli+")"
+       
+    
+        ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        
+        hostname = "KALI"
+        pythonexec= "/usr/bin/python"
+        
+        
+        hip_cur_version = "/home/rolex/HIP/1.41.0/hip-1.41.0-"+hostname
+                    
+##################################################################################################################################
+##################################################################################################################################
+##################################################################################################################################
+
+  
+        
+        
+        
+        ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            avsp_home =  "/home/rolex/QUIET_5.3/AVSP_HOME"
+            # Temporary, bug with axisym duplication in HIP v1.41.0
+            hip_cur_version = "/home/rolex/HIP/1.40.1/hip-1.40.1-"+hostname
+            avsptool = plugin_avsp(avsp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = avsptool.switch_avsp_tools(appli,command)
+            
+            
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            command_exe = hip_cur_version+" < " + command
+            
+        
+        #############
+        # PROJETEUR #
+        #############
+        if appli == "projeteur":
+            if command == "-c3s_auto_hip_dumpskin-":
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_skin.py"),"-c3sm_auto_hip-",hip_cur_version)
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_skin.py"),"-c3sm_auto_h5dump-","h5dump")
+                command_exe = "/usr/bin/python ./script_skin.py"
+                
+        ###########
+        # COOLANT #
+        ###########
+        if appli == "coolant":
+            coolant_version =  "/home/rolex/exe_coolant_rolex/coolant09.x.LINUX"
+            if command == "-c3sm_auto_coolant-":
+                command_exe = coolant_version+ " < ./input_coolant.dat"
+    
+        ########
+        # AVBP #
+        ########
+        if appli == "tool_avbp621":
+            avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+            avbptool = plugin_avbp(avbp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = avbptool.switch_avbp_tools(appli,command)           
+
+        ############
+        # ICRITLES #
+        ############
+        if appli == "tool_icritles":
+            if command == "-c3sm_auto_icritles-":
+                avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+                command_exe = avbp_home+"/HOST/"+hostname+"/TOOLEXEC/i_crit_les.e_"+hostname
+
+        ########
+        # MPS  #
+        ########
+        if appli == "mps_script":
+            if command.startswith("-c3sm_auto"):
+                if command == "-c3sm_auto_mps-" :
+                    datafile = os.path.join(self.distantDirectory,execDirectory,"aerotherm.xml")
+#                   execDirectory = "/home/rolex/multiphysics_setup"
+                    command_exe = "cd /home/rolex/multiphysics_setup ; mpview -aerotherm_xml "+datafile
+
+
+        ########
+        # AVTP #
+        ########
+        if appli == "tool_avtp2":
+            avtp_home = "/home/rolex/AVTP/AVTP_V2.X"
+            avtptool = plugin_avtp(avtp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = avtptool.switch_avtp_tools(appli,command)           
+
+            
+        ###########
+        # PRISSMA #
+        ###########
+        if appli == "tool_prissma":
+            avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+            prissma_home = "/home/avtp_wkdir/PRISSMA/trunk/"
+            prissmatool = plugin_prissma(prissma_home,avbp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = prissmatool.switch_prissma_tools(appli,command)
+        
+##################################################################################################################################
+##################################################################################################################################
+##################################################################################################################################
+
+
+
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+        
+        
+        #####################
+        # SENDING DIRECTORY #
+        #####################
+        print "Final composition of c3sm_archive:"
+        print self.dir2send
+        XDR.ssh_send(self.machine,self.login, self.distantDirectory, self.dir2send, options="")   
+        
+       
+        #####################
+        # EXECUTING COMMAND #       
+        #####################
+        sshCommand = "cd "+self.distantDirectory+"/"+execDirectory+"; "+command_exe    
+        # NB : -X allows here an interactive action       
+        output = XDR.ssh(self.machine,self.login, sshCommand, options="-X")
+        
+        # back to the initial directory
+        os.chdir(local_directory)
+        return output
+        
+    def retrieveDirectory(self,directory):
+        
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        # Retrieve Directory
+        if os.path.exists(local_directory):
+            shutil.rmtree(local_directory)
+    
+        #XDR.ssh_retrieve(self.machine,self.login, self.distantDirectory+"/"+dist_directory, os.path.dirname(local_directory), options="")   
+        #scpCommand = "scp -r "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+        # DANGEROUS , Il faudrait desaliaser le rsync au cas ou l'utilisateur l'aurait surcharge"
+        scpCommand = "rsync -a "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+        XDR.execute(scpCommand)
+        
+        
+    def removeDirectory(self,directory):
+        sshCommand = "/bin/rm -rf "+self.distantDirectory+"/"+directory
+        output = XDR.ssh(self.machine,self.login, sshCommand, options="-X")    
+        #XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+    
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/local_unix.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/local_unix.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/local_unix.py	(revision 4775)
@@ -0,0 +1,137 @@
+import os,XDR
+
+from avbp import plugin_avbp
+from avtp import plugin_avtp
+from prissma import plugin_prissma
+
+
+class local_unix(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+    def sendDirectory(self,directory):
+        
+        if os.path.exists(directory):
+            return 1
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+         ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        
+        
+        hostname = "KALI"
+        pythonexec= "/usr/bin/python"
+        hip_cur_version = "/home/rolex/HIP/1.41.0/hip-1.41.0-"+hostname
+        
+##################################################################################################################################
+##################################################################################################################################
+##################################################################################################################################
+
+         #####################
+        # SECTION DEPENDING ON APPLICATIONS
+        ####################
+        supported_applis.append("tool_avsp52") 
+        supported_applis.append("tool_avbp621") 
+        supported_applis.append("tool_avtp2")
+        supported_applis.append("tool_prissma")
+        supported_applis.append("tool_icritles")
+        supported_applis.append("mps_script") 
+        supported_applis.append("hip_script")
+        supported_applis.append("hip_current")
+        supported_applis.append("dummy")
+        
+        if appli not in supported_applis:
+            XDR.error("this application requires the application tag "+ appli+ ", which is not supported by the plugin local_unix.")
+
+        ########
+        # AVBP #
+        ########
+        if appli == "tool_avbp621":
+               avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+               avbptool = plugin_avbp(avbp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+               command_exe = avbptool.switch_avbp_tools(appli,command)    
+                    
+
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            command_exe = hip_cur_version+" < " + command
+
+            
+         ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            avsp_home =  "/home/rolex/QUIET_5.3/AVSP_HOME"
+            # Temporary, bug with axisym duplication in HIP v1.41.0
+            hip_cur_version = "/home/rolex/HIP/1.40.1/hip-1.40.1-"+hostname
+            avsptool = plugin_avsp(avsp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = avsptool.switch_avsp_tools(appli,command)
+
+         ########
+        # AVTP #
+        ########
+        if appli == "tool_avtp2":
+            avtp_home = "/home/rolex/AVTP/AVTP_V2.X"
+            avtptool = plugin_avtp(avtp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = avtptool.switch_avtp_tools(appli,command)           
+
+        ############
+        # ICRITLES #
+        ############
+        if appli == "tool_icritles":
+            if command == "-c3sm_auto_icritles-":
+                avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+                command_exe = avbp_home+"/HOST/"+hostname+"/TOOLEXEC/i_crit_les.e_"+hostname
+                
+        ###########
+        # PRISSMA #
+        ###########
+        if appli == "tool_prissma":
+            avbp_home = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1"
+            prissma_home = "/home/avtp_wkdir/PRISSMA/trunk/"
+            prissmatool = plugin_prissma(prissma_home,avbp_home,hostname,hip_cur_version,pythonexec,execDirectory)
+            command_exe = prissmatool.switch_prissma_tools(appli,command)
+
+        ########
+        # MPS  #
+        ########
+        if appli == "mps_script":
+            if command.startswith("-c3sm_auto"):
+                if command == "-c3sm_auto_mps-" :
+                    datafile = os.path.join(local_directory,execDirectory,"aerotherm.xml")
+                    execDirectory = "/home/rolex/multiphysics_setup"
+                    command_exe = "mpview -aerotherm_xml "+datafile
+        
+##################################################################################################################################
+##################################################################################################################################
+##################################################################################################################################
+
+        os.chdir(execDirectory)
+        output = XDR.execute(command_exe)
+        os.chdir(local_directory)
+        return output
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/no_plugin.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/no_plugin.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/no_plugin.py	(revision 4775)
@@ -0,0 +1,26 @@
+import os,XDR
+
+class no_plugin(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+    def sendDirectory(self,directory):
+        print "sendDirectory with firectory  :",directory
+        
+    def executeDistantCommand(self,command,exec_directory,appli,flags=[]):
+        print "executeDistantCommand with arguments :"
+        print "command : ",command
+        print "exec_directory : ",exec_directory
+        print "flags : ",flags
+        print "Warning : executeDistantCommand no_plugin selected, nothing gonna be done here..."
+        
+    def retrieveDirectory(self,directory):
+        print "Warning : retrieveDirectory no_plugin selected, nothing gonna be done here..."
+        pass
+    
+    def removeDirectory(self,directory):
+        print "Warning : removeDirectory no_plugin selected, nothing gonna be done here..."
+        pass
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/robot_unix.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/robot_unix.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/robot_unix.py	(revision 4775)
@@ -0,0 +1,174 @@
+import os,XDR,time
+
+class robot_unix(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+    def sendDirectory(self,directory):
+        
+        if os.path.exists(directory):
+            return 1
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        
+    def executeDistantCommand(self,command,exec_directory,appli,flags=[]):
+        print "Plugin : Using Robot Unix : "+command+" ("+appli+")"
+       
+    
+        ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        
+        
+         #####################
+        # SECTION DEPENDING ON APPLICATIONS
+        ####################
+        supported_applis.append("tool_avsp52") 
+        supported_applis.append("hip_current") 
+        supported_applis.append("dummy")
+        
+        if appli not in supported_applis:
+             XDR.error("this application requires the application tag "+ appli+ ", which is not supported by the plugin library\DATA\pluginscripts\robot_unix.")
+            
+  
+        ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            toolAVSPhome = "/appl/APPLI_SNECMA/AVSP/test/5.2/AVSP_HOME/HOST/ZEPHYR/TOOLEXEC"
+            if command == "-c3sm_auto_avbp2avsp_exec-":
+                command_exe = toolAVSPhome + "/avbp2avsp_ZEPHYR.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = toolAVSPhome + "/avspinitsol_ZEPHYR.exe"
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = toolAVSPhome + "/preproc_mlpf_ZEPHYR.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = toolAVSPhome + "/Zinn_nozzle_ZEPHYR.exe"
+           
+            
+            
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            toolHIPhome = "/appl/APPLI_SNECMA/HIP/simu/1.36.0"
+            if command == "-c3s_auto_hip_scripttxt-":
+                command_exe= toolHIPhome + "/hip < ./script.txt"
+            
+            
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+        
+       
+        # get the user name
+        username = os.getenv('USERNAME')
+        
+        # get the original path
+        oldDir = os.path.abspath(os.getcwd())
+        
+        # build the path to the tool
+        fullexec_directory = os.path.join(oldDir,exec_directory)
+        
+        # convert into UNIX path
+        pathlist = fullexec_directory.split("\\")
+        newpath = []
+        for item in pathlist :
+            if item == "windata" :
+                item = "data"
+            if item.endswith("_Recherches") :
+                register = item.split("_")[0] 
+                item = "Recherches"
+                
+            if item != "" :
+                newpath.append(item)
+            
+        newpath = "/"+"/".join(newpath)
+        fullexec_directory_unix = newpath
+        
+        
+        # open the user's robot input file, and set the operating directory
+        user_robot_file=os.path.join("\\\\windata\\"+register+"_Recherches\\METHODES_LES\\_Chambre\\TAF\\ROBOT", username, "robot.in")
+        inputfile = open(user_robot_file, 'w')
+        inputfile.writelines(fullexec_directory_unix)
+        inputfile.close()
+        
+        
+        os.chdir(exec_directory)
+        print "Robot archive created in "+fullexec_directory
+        
+        # create the batch
+        batchname = os.path.join(fullexec_directory,"batch_c3sm.todo")
+        batchname_done = os.path.join(fullexec_directory,"batch_c3sm.done")
+        batchname_run = os.path.join(fullexec_directory,"batch_c3sm.run")
+        batchname_fail = os.path.join(fullexec_directory,"batch_c3sm.fail")
+        
+        
+        batchContent =  "#!/bin/sh \n"
+        batchContent+=command_exe
+        batchFile = open(batchname,'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+        
+        # ONCE THE BATCH is created, the robot should work on it withing 5 sec
+        status = "waiting"
+        # check is job is processed 
+        max_delay = 15
+        delay = 0
+        while status=="waiting":
+            time.sleep(0.01)
+            print "Waiting for the robot :"+batchname_run
+            if os.path.exists(batchname_run):
+                status="running"
+            if os.path.exists(batchname_done):
+                status="done"
+            print "First loop"
+            
+            time.sleep(2)
+            delay += 2
+            if delay >= max_delay :
+                print "Warning : "+str(max_delay)+" sec  without answer from the robot \n Please, check if your robot is up and running on Zephyr"
+                status="no_robot"
+                
+        
+        
+        # check if job is done, max 30 min
+        max_delay = 1800
+        while status=="running" :
+            time.sleep(0.01)
+            print "Waiting for the end of the run :"
+            if os.path.exists(batchname_done):
+                status="done"
+            if os.path.exists(batchname_fail):
+                status="fail"
+                error("Robot tried to execute the tool and failed...")
+            print "Second loop"    
+            time.sleep(2)
+            delay += 2
+
+            if delay >= max_delay :
+                print "Warning : "+str(max_delay)+" sec  without answer from the robot \n Run beyond the time limit of robot"
+                status="too_long"
+
+        print "Final status : "+status
+        print "Final delay : "+str(delay) +" sec."
+        
+
+        # clean the robot input file to stop him from searching 
+        inputfile = open(user_robot_file, 'w')
+        inputfile.close()
+        
+        # come back to old directory
+        os.chdir(oldDir)
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_runappli.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_runappli.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_runappli.py	(revision 4775)
@@ -0,0 +1,195 @@
+import os,XDR,shutil,sys
+
+import pckgfile
+if sys.platform.startswith('linux'):
+    RUNAPPLIDIR="/gpfs/appl/APPLI_SNECMA/RUNAPPLI"
+    PYTHONEXE="/gpfs/appl/APPLI_SNECMA/PYTHON/Python-2.5.4/python"
+else:
+    RUNAPPLIDIR="//winappl/calcul2000/Runappli"
+    #utilisation du python non-graphique avec le "w"
+    PYTHONEXE="//winappl/calcul2000/Outils/Python/Oper/v2.5.1/pythonw.exe"
+
+
+
+class snecma_runappli(XDR.Plugin):  
+    def __init__(self,typePlugin):
+        """ This method built a new instance of plugin.
+        First it constructs the plugin thanks to mother class : XDR.Plugin"""
+        
+        # Il ne faut surtout pas supprimer cette ligne
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        # Ici, je stocke les donnees du config que je pourrais avoir besoin plus tard 
+        self.version_ra = self.getPluginParam("version_ra")
+        self.platform = self.getPluginParam("platform")
+        self.nbprocs = self.getPluginParam("nbprocs")
+        self.memory = self.getPluginParam("memory")
+        self.duration = self.getPluginParam("duration")
+        self.noclean = self.getPluginParam("noclean")
+        self.runapplidir = RUNAPPLIDIR
+        self.pythonexe = PYTHONEXE
+
+        
+        self.dir2send = []
+        # Ici, pour les autres plugins, je verifie que tous mes dossiers existent bien, sinon, je les cree
+        if self.platform=="curie":
+            self.platformname = "CURIE"
+        if self.platform=="airain":
+            self.platformname = "AIRAIN"
+        if self.platform=="zephyr":
+            self.platformname = "ZEPHYR"
+        if self.platform=="titane":
+            self.platformname = "TITANE"
+        self.ra_path = self.version_ra.replace("#","/")
+
+
+
+        
+    # Applications supportes par Runappli a snecma
+    @XDR.supported_applications(['avsp52','yales2_1007','yales2_1008'])
+
+
+
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+        """ This command executes command in execDirectory on distant machine.
+        Flags can be specified, they depend on the code and the plugin
+        """
+
+        print "Running executeDistantCommand "+command+" in "+execDirectory+" for appli"+appli
+        ########
+        # INITS
+        ########
+        command_exe = command
+        appli_keyword = "none"
+        local_directory = os.getcwd()
+        
+        if self.platform=="zephyr":
+# Creating batch file for ZEPHYR
+            batchContent =  "#!/bin/bash\n"
+            pythonexec = "/appl/APPLI_SNECMA/PYTHON/2.7.3/bin/python"
+        else:
+# Creating batch file for CEA
+            batchContent =  "#!/bin/bash\n"
+            batchContent+=  "source /etc/profile.d/modules.sh\n"
+            pythonexec = "/usr/bin/python"
+
+#############################################################################                
+#############################################################################                
+#############################################################################                
+
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            if  self.platform=="zephyr":
+                homeAVSP52="/appl/APPLI_SNECMA/AVSP/test/5.2.0"
+                batchContent += "export LD_LIBRARY_PATH=/appl/APPLI_SNECMA/COMPOSANTS_COMMUNS/HDF5/oper/1.8.5-P1/hdf5-1.8.5-patch1-linux-x86_64-shared/lib:$LD_LIBRARY_PATH\n"        
+                avsp_command =  "mpirun  -np "+ self.nbprocs+" "+homeAVSP52+"/AVSP.exe"
+            else :
+                homeAVSP52="/ccc/cont001/home/snecma/snecma/APPLI_SNECMA/AVSP/test/5.2.0"
+                batchContent += "module load hdf5/1.8.5\n"
+                avsp_command = "ccc_mprun -x -n "+ self.nbprocs+" "+homeAVSP52+"/AVSP.exe"
+
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "cp "+homeAVSP52+"/quiet3.py . ; " + pythonexec + " ./quiet3.py &> ./quiet.out"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = homeAVSP52+"/Anozzle.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+ 
+	##########
+	# YALES2 #
+	##########
+	if appli in ["yales2_1007","yales2_1008"] :
+	    if  self.platform=="zephyr":
+		error("Yales2 is not available on Zephyr")
+	    else :
+		
+		if appli == "yales2_1007" :
+		    version_yales2 = " "
+		if appli == "yales2_1008" :
+		    version_yales2 = "v_1.0.0.8"
+		    
+		
+		batchContent +="export YALES2_HOME=/ccc/cont001/home/snecma/snecma/APPLI_SNECMA/YALES2/test/"+self.platformname+"/"+ version_yales2+"\n "
+		batchContent +="export YALES2_HOSTTYPE="+self.platform +"\n "
+		batchContent +="export PATH=$PATH:$YALES2_HOME/tools \n "  
+		batchContent +="export LD_LIBRARY_PATH=/usr/local/hdf5-1.8.5/lib:$LD_LIBRARY_PATH \n "
+			
+		batchContent +="cd "+execDirectory+"\n "
+		
+		batchContent +="# PROLOGUE \n "
+		batchContent +="module load hdf5/1.8.5 \n "
+		batchContent +="module load parmetis \n "
+		batchContent +="module load fftw3 \n "
+		batchContent +="module load scotch \n "
+		batchContent +="module load petsc/3.2-p7_real \n "
+		batchContent +="module load slepc/3.2-p4 \n "
+		
+		batchContent +="make \n "
+		batchContent +="mkdir dump \n "
+		batchContent +="mkdir postprocdump \n "
+		
+		batchContent +="set -x \n "
+		batchContent +="sed -i.bak 's:\\:/:g' \n "
+		batchContent += "cd ..\n"
+		command_exe = "ccc_mprun -x -n "+self.nbprocs+" ./caseYales2"
+                    
+#############################################################################                
+#############################################################################                
+#############################################################################                
+
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )       
+                    
+        
+        batchContent += """cd """+execDirectory+"\n"
+        batchContent +=command_exe+"\n"
+        batchContent += "cd ..\n"
+        
+        batchFile = open("batch_c3sm",'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+        self.dir2send.append("batch_c3sm")
+        
+        # create a zip archive of the directories list
+        print "Ok : Repertoires envoyes : "+" ".join(self.dir2send)
+        archive=pckgfile.PckgFile(os.path.join(".", "c3sm_archive.tar"), 'w')
+        for file in self.dir2send: archive.write(file)
+        archive.close()
+        
+        # Creating runappli script
+        os.environ["RA_C3SM_ANALYSE"]=r"0"
+        os.environ["RA_C3SM_DATA_IN"]=os.getcwd()
+        os.environ["RA_C3SM_FILE"]="c3sm_archive.tar"
+
+        #Cree la ligne de commandes
+        cmd = "%(pythonexe)s %(runapplidir)s/%(ra_path)s/run_appli.py "
+        cmd += " -a C3SM"
+        cmd += " -A C3SM"
+        cmd += " -V SEQ"
+        cmd += " -p %(platformname)s"
+        cmd += " -n %(nbprocs)s"
+        cmd += " -c %(duration)s"
+        cmd += " -m %(memory)s"
+        if self.noclean == "1" :
+	    cmd += " -k"
+        cmd += " -e null"
+        cmd += " -i auto"
+        cmd += " -Z tar"
+        cmd%=self.__dict__
+        print cmd
+        # ici on utilise os.system pour avoir les variables d'environnement, contrairement a XDR.execute.
+        out=os.system(cmd)
+        print out        
+
+        if "myflag" in flags:
+            pass
+    def retrieveDirectory(self,directory):
+        """ This command retrieves directory in current local directory
+        """
+        pass
+     
+    def removeDirectory(self,directory):
+        """ This command delete distant directory, if directory is "*", delete the project directory"""
+        pass
+        
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_windows2zephyr.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_windows2zephyr.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_windows2zephyr.py	(revision 4775)
@@ -0,0 +1,211 @@
+import os,XDR,time,shutil
+
+RUNAPPLIDIR=r'\\winappl\calcul2000\Runappli\Simu\V04R02'
+
+class snecma_windows2zephyr(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+
+    @XDR.supported_applications(["tool_avsp52","hip_current","hip_script","yales2"])        
+    def executeDistantCommand(self,command,exec_directory,appli,flags=[]):
+        print "Plugin : Using Robot Unix : "+command+" ("+appli+")"
+       
+    
+        ########
+        # INITS
+        ########
+        command_exe = command
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        
+
+##############################################################################
+##############################################################################
+##############################################################################
+
+        ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            toolAVSPhome = "/appl/APPLI_SNECMA/AVSP/test/5.2/AVSP_HOME/HOST/ZEPHYR/TOOLEXEC"
+            if command == "-c3sm_auto_avbp2avsp_exec-":
+                command_exe = toolAVSPhome + "/avbp2avsp_ZEPHYR.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = toolAVSPhome + "/avspinitsol_ZEPHYR.exe"
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = toolAVSPhome + "/preproc_mlpf_ZEPHYR.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = toolAVSPhome + "/Zinn_nozzle_ZEPHYR.exe"
+           
+            
+     
+		#######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            homehip="/appl/APPLI_SNECMA/HIP/test/"
+            hip_cur_version =  homehip + "1.39.3" + "/hip.exe"
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            homehip="/appl/APPLI_SNECMA/HIP/test/"
+            hip_cur_version =  homehip + "1.39.3" + "/hip.exe"
+            command_exe = hip_cur_version+ " < " + command
+
+	########
+        # YALES2 #
+        ########
+				
+        if appli == "yales2" :
+            if command == "-load_chemtable-":
+                 temp_path = exec_directory
+                 table_path = '/data/Recherches/METHODES_LES/_Chambre/TAF/YALES2/TABLES_CHIMIQUES/'
+                 XDR.replace_pattern_in_file(os.path.join(temp_path,"batch_chemtable"),"-table_path-",table_path)
+		#####
+            	# Prepare command
+            	 command_exe = "chmod +x ./batch_chemtable; dos2unix ./batch_chemtable; ./batch_chemtable"    
+
+				       
+##############################################################################
+##############################################################################
+##############################################################################
+            
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+        
+       
+        # get the user name
+        username = os.getenv('USERNAME')
+        
+        # get the original path
+        oldDir = os.path.abspath(os.getcwd())
+        
+        # build the path to the tool
+        fullexec_directory = os.path.join(oldDir,exec_directory)
+       
+
+        # convert into UNIX path
+        fullexec_directory_unix =  self.convert_unc_filename(fullexec_directory)
+        
+        # open the user's robot input file, and set the operating directory
+        user_robot_file = os.path.join(r"\\windata\128_Recherches\METHODES_LES\_Chambre\TAF\C3SM", username, "robot.in")
+        inputfile = open(user_robot_file, 'w')
+        inputfile.writelines(fullexec_directory_unix)
+        inputfile.close()
+        
+        
+        os.chdir(exec_directory)
+        print "Robot archive created in "+fullexec_directory
+        
+        # create the batch
+        batchname = os.path.join(fullexec_directory,"batch_c3sm.todo")
+        batchname_done = os.path.join(fullexec_directory,"batch_c3sm.done")
+        batchname_run = os.path.join(fullexec_directory,"batch_c3sm.run")
+        batchname_fail = os.path.join(fullexec_directory,"batch_c3sm.fail")
+        
+        
+        batchContent =  "#!/bin/sh \n"
+        batchContent+=command_exe
+        batchFile = open(batchname,'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+        
+        # ONCE THE BATCH is created, the robot should work on it withing 5 sec
+        status = "waiting"
+        # check is job is processed 
+        max_delay = 15
+        delay = 0
+        while status=="waiting":
+            time.sleep(0.01)
+            print "Waiting for the robot :"+batchname_run
+            if os.path.exists(batchname_run):
+                status="running"
+            if os.path.exists(batchname_done):
+                status="done"
+            print "First loop"
+            
+            time.sleep(2)
+            delay += 2
+            if delay >= max_delay :
+                print "Warning : "+str(max_delay)+" sec  without answer from the robot \n Please, check if your robot is up and running on Zephyr"
+                status="no_robot"
+                
+        
+        
+        # check if job is done, max 30 min
+        max_delay = 1800
+        while status=="running" :
+            time.sleep(0.01)
+            print "Waiting for the end of the run :"
+            if os.path.exists(batchname_done):
+                status="done"
+            if os.path.exists(batchname_fail):
+                status="fail"
+                error("Robot tried to execute the tool and failed...")
+            print "Second loop"    
+            time.sleep(2)
+            delay += 2
+
+            if delay >= max_delay :
+                print "Warning : "+str(max_delay)+" sec  without answer from the robot \n Run beyond the time limit of robot"
+                status="too_long"
+
+        print "Final status : "+status
+        print "Final delay : "+str(delay) +" sec."
+        
+
+        # clean the robot input file to stop him from searching 
+        inputfile = open(user_robot_file, 'w')
+        inputfile.close()
+        try:
+		    os.remove(batchname_done)
+        except Exception: 
+		    pass
+		
+        # come back to old directory
+        os.chdir(oldDir)
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
+     
+    def convert_unc_filename(self,filepath):
+        import sys,os
+
+        if os.path.isdir(RUNAPPLIDIR):
+            p=os.path.join(RUNAPPLIDIR,'PyModules')
+            if not p in sys.path: sys.path.append(p)
+            import Filesystem
+            Filesystem.FILE=os.path.join(RUNAPPLIDIR,'Env','UNC.txt')
+            unix_filename = Filesystem.convert_unc_filename(filepath,strict=1)
+            if not unix_filename:
+                XDR.error("Le chemin '%s' n'existe pas sous unix.\nVerifier que votre projet est construit sur \\\\windata"%filepath)
+        else:
+            XDR.error("Le repertoire '%s' n'existe plus.\nContacter le garant pour qu'il mette a jour la ligne 3 du plugin %%C3SM_HOME%%\\library\\DATA\\pluginscripts\\snecma_windows2zephyr.py"%RUNAPPLIDIR)
+        return unix_filename
+     
+    def convert_nfs_filename(self,filepath):
+        import sys,os
+
+        if os.path.isdir(RUNAPPLIDIR):
+            p=os.path.join(RUNAPPLIDIR,'PyModules')
+            if not p in sys.path: sys.path.append(p)
+            import Filesystem
+            Filesystem.FILE=os.path.join(RUNAPPLIDIR,'Env','UNC.txt')
+            windows_filename = Filesystem.convert_nfs_filename(filepath)
+            if not windows_filename:
+                XDR.error("Le chemin '%s' n'existe pas sous unix.\nVerifier que votre projet est construit sur \\\\windata"%filepath)
+        else:
+            XDR.error("Le repertoire '%s' n'existe plus.\nContacter le garant pour qu'il mette a jour la ligne 3 du plugin %%C3SM_HOME%%\\library\\DATA\\pluginscripts\\snecma_windows2zephyr.py"%RUNAPPLIDIR)
+        return windows_filename
+     
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_zephyr_local.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_zephyr_local.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/snecma_zephyr_local.py	(revision 4775)
@@ -0,0 +1,82 @@
+import os,XDR,shutil
+
+class  snecma_zephyr_local(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+    
+    
+
+    @XDR.exec_command
+    @XDR.supported_applications(['hip_current','hip_script','tool_avsp52','yales2'])
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+##########################################################################################
+##########################################################################################
+##########################################################################################
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            homehip="/appl/APPLI_SNECMA/HIP/test/"
+            hip_cur_version =  homehip + "1.39.3" + "/hip.exe"
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            homehip="/appl/APPLI_SNECMA/HIP/test/"
+            hip_cur_version =  homehip + "1.39.3" + "/hip.exe"
+            command_exe = hip_cur_version+ " < " + command
+
+            
+         ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            homeAVSP52="/appl/APPLI_SNECMA/AVSP/test/5.2.0/"
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = homeAVSP52+"preproc_mlpf_ZEPHYR.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = homeAVSP52+"avspinitsol_ZEPHYR.exe"
+            if command == "-c3sm_auto_avbp2avsp_exec-":
+                command_exe = homeAVSP52+"avbp2avsp_ZEPHYR.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = homeAVSP52+"Zinn_nozzle_ZEPHYR.exe"
+
+		########
+        # YALES2 #
+        ########
+				
+        if appli == "yales2" :
+			if command == "-load_chemtable-":			
+				# I use execDirectory to pass chemtable file name
+				
+				table_file = exec_directory
+				exec_directory = 'tmp'
+				own_path = os.getcwd()
+				tmp_local = os.path.join(own_path,"tmp")
+				script_path = XDR.getScriptDir()
+				
+				# Copy template batch file
+				batch_template_path = os.path.join(script_path,"batch_chemtable")
+				shutil.copy(batch_template_path,tmp_local)			
+				# Replace pattern in local copy of the template
+				batch_local_path = os.path.join(tmp_local,"batch_chemtable")
+				XDR.replace_pattern_in_file(batch_local_path,"table_path",table_file)					
+				# Prepare command
+				command_exe = "chmod +x ./batch_chemtable; dos2unix ./batch_chemtable; ./batch_chemtable"        
+##########################################################################################
+##########################################################################################
+##########################################################################################			
+        XDR.check_command_exe(command_exe)
+	
+        os.chdir(execDirectory)
+        XDR.execute(command_exe)
+        
+    def retrieveDirectory(self,directory):
+        # Do nothing as we are local
+        pass
+    
+    def removeDirectory(self,directory):
+        pass
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_local.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_local.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_local.py	(revision 4775)
@@ -0,0 +1,151 @@
+import os,XDR
+import shutil
+import re
+
+class turbomeca_btmclx2_local(XDR.Plugin):
+    
+    
+    # 
+    def __init__(self,typePlugin):
+	"""This method transfer the informations form the XML file to the present code
+	it should essentially involve lines of type
+	self.myparam = self.getPluginParam("mypram_in_the_xml")"""
+        XDR.Plugin.__init__(self, typePlugin)
+    	self.nbprocs = self.getPluginParam("nbprocs")
+    
+    @XDR.exec_command 
+    @XDR.supported_applications(['tool_avsp52','tool_avbp621','yales2','hip_current','hip_script'])
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+	"""This method will interpret commands sent from
+	python scripts associated to a C3Sm application
+	
+	Code-specific management must be done here, and only here.
+	"""
+        
+##############################################################################################################################        
+##############################################################################################################################
+##############################################################################################################################
+        ########
+        # AVBP #
+        ########
+        if appli == "tool_avbp621":
+            hip_cur_version = "/Avbp/versions/bin/hip"
+            avbp_home = "/Avbp/versions/AVBP_V6.2"
+            avbp_scripts = os.path.join(avbp_home,"TOOLS","BIN","SCRIPTS")
+
+            if command.startswith("-c3sm_auto_"):
+
+                command_exe=""
+
+
+                if command.startswith("-c3sm_auto_loadmesh-"):
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_meshinfo-",os.path.join(avbp_scripts,"meshinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_mesh.py"),"-c3sm_auto_get_patch_surf-",os.path.join(avbp_scripts,"get_patch_surf "))
+                    command_exe+= "/usr/bin/python ./script_mesh.py"
+
+                if command.startswith("-c3sm_auto_track-"):
+                    command_exe += command.replace("-c3sm_auto_track-",os.path.join(avbp_scripts,"track "))
+
+                if command.startswith("-c3sm_auto_tadia-"):
+                    command_exe += command.replace("-c3sm_auto_tadia-",os.path.join(avbp_scripts,"tadia "))
+
+                if command.startswith("-c3sm_auto_flame_param-"):
+                    command_exe += command.replace("-c3sm_auto_flame_param-",os.path.join(avbp_scripts,"flame_param "))
+
+                if command == "-c3sm_auto_prepare_boundary-":
+                    print "my friend"
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_hip-",hip_cur_version)
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makesolutbound-",os.path.join(avbp_scripts,"makesolutbound "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_genprofile-",os.path.join(avbp_scripts,"genprofile2 "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_boundaries.py"),"-c3sm_auto_makeinject-",os.path.join(avbp_scripts,"makeinject "))
+                    command_exe+= "/usr/bin/python ./script_boundaries.py"
+
+                if command == "-c3sm_auto_initsol-":
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_solinfo-",os.path.join(avbp_scripts,"solinfo "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_vortex-",os.path.join(avbp_scripts,"addvortex "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_makesolution-",os.path.join(avbp_scripts,"makesolution "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_spec-",os.path.join(avbp_scripts,"add_spec "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_init_spec-",os.path.join(avbp_scripts,"init_spec "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_gas_out-",os.path.join(avbp_scripts,"gas_out "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_ign_sphere-",os.path.join(avbp_scripts,"ignition_sphere "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_tpf-",os.path.join(avbp_scripts,"add_tpf "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_add_fic-",os.path.join(avbp_scripts,"add_fic "))
+                    XDR.replace_pattern_in_file(os.path.join(execDirectory,"script_init.py"),"-c3sm_auto_check_perio-",os.path.join(avbp_scripts,"check_perio "))
+                    command_exe+= "/usr/bin/python ./script_init.py"
+
+                if command.startswith("-c3sm_auto_xtools-"):
+                    command_exe=command.replace("-c3sm_auto_xtools-","")
+ 
+        #######
+        # HIP #
+        #######
+        if appli == "hip_current":
+            hip_cur_version =  "/Avbp/versions/bin/hip"
+            if command.startswith("-c3sm_auto_hip-"):
+                command_exe = command.replace("-c3sm_auto_hip-",hip_cur_version)
+            elif command == "-c3s_auto_hip_scripttxt-":
+                command_exe= hip_cur_version+" < ./script.txt"
+
+        if appli == "hip_script":
+            command_exe = "/Avbp/versions/bin/hip < " + command
+    
+        ########
+        # AVSP #
+        ########
+        if appli == "tool_avsp52":
+            avsp_home = "/Avbp/versions/ARCHIVE_QUIET/QUIET/QUIET_TM/AVSP_HOME_2"
+            tools_rep ="/HOST/BTMCLX2/TOOLEXEC/"
+            if command == "-c3sm_auto_preproc_mlpf_exec-":
+                command_exe = avsp_home+tools_rep+"preproc_mlpf_BTMCLX2.exe"
+            if command == "-c3sm_auto_avspinitsol_exec-":
+                command_exe = avsp_home+tools_rep+"avspinitsol_BTMCLX2.exe"
+            if command == "-c3sm_auto_avbp2avsp_exec-":
+                command_exe = avsp_home+tools_rep+"avbp2avsp_BTMCLX2.exe"
+            if command == "-c3sm_auto_zinn_exec-":
+                command_exe = avsp_home+tools_rep+"Zinn_nozzle_BTMCLX2.exe"
+
+        
+	##########
+	# YALES2 #
+	#########
+	if appli == "yales2":
+		
+		script_path = XDR.getScriptDir()
+		
+		if command == "-c3sm_YALES2_auto_exe-":
+		
+			#NO JOB RUNNING ON BTMCLX2 only tools execution
+			XDR.error("Job cann't run on BTMCLX2 (code plugin) only tools execution. Change your config.xml code plugin available are for soumi or CCRT")
+		
+		elif command == "-load_chemtable-":
+						
+			table_path=XDR.getValue("table",XDR.getValue("eos","chemistry"),"eos","chemistry")
+			table_path=os.path.split(table_path)[0]+'/'
+			# Replace pattern
+			XDR.replace_pattern_in_file(os.path.join(execDirectory,"batch_chemtable"),"-table_path-",table_path)						
+			# Prepare command
+			batch_path=os.path.join(execDirectory,'batch_chemtable')
+			XDR.execute("chmod +x "+batch_path)			
+			command_exe = "/bin/bash ./batch_chemtable"
+							
+		else:
+			XDR.error("Command unknown")
+			
+
+##############################################################################################################################        
+##############################################################################################################################
+##############################################################################################################################
+
+        os.chdir(execDirectory)   
+        XDR.execute(command_exe)     
+        os.chdir(self.local_directory)
+        
+    def retrieveDirectory(self,directory):
+	"""This method will download some directories on the ressource
+	  or do nothing if its local"""
+        pass
+    
+    def removeDirectory(self,directory):
+        """This method will remove some directories on the ressource
+	  Rarely used, kept for backward compatibility"""
+        pass
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_soumi.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_soumi.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_btmclx2_soumi.py	(revision 4775)
@@ -0,0 +1,137 @@
+import os,XDR,shutil
+
+class turbomeca_btmclx2_soumi(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        """ This method built a new instance of plugin.
+        First it constructs the plugin thanks to mother class : XDR.Plugin"""
+
+        XDR.Plugin.__init__(self, typePlugin)
+               
+        self.directory = self.getPluginParam("directory") 
+        self.nbprocs = self.getPluginParam("nbprocs") 
+        self.memory = self.getPluginParam("memory") 
+        self.duration =  self.getPluginParam("duration") 
+        self.external = self.getPluginParam("external")  
+        
+        
+        self.dir2send = []
+        
+        
+    @XDR.supported_applications(['avsp52','avbp621','yales2_1007','yales2_1008'])  
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):
+        """ This command executes command in execDirectory on distant machine.
+        Flags can be specified, they depend on the code and the plugin
+        """
+
+        ########
+        # INITS
+        ########
+        command_exe = command
+        appli_keyword = "none"
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+       #####################
+        # SECTION FOR ALL APPLICATIONS
+        ####################
+                
+#############################################################################################################################
+#############################################################################################################################
+#############################################################################################################################
+        
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            avsp_home = "/Avbp/versions/ARCHIVE_QUIET/QUIET/QUIET_TM/AVSP_HOME_2"
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "cd "+execDirectory+" ; python "+avsp_home+"/TOOLS/quiet3.py"
+                appli_keyword = "AVSP"
+                avsp_command = "mpirun -np "+self.nbprocs+ " " + avsp_home+"/HOST/BTMCLX2/AVSPEXEC/AVSP_V5.2.BTMCLX2"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = "$AVSP_HOME/HOST/BTMCLX2/anozzle.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+        ########
+        # AVBP #
+        ########
+        if appli == "avbp621":
+            avbp_home ="/Avbp/versions/AVBP_V6.2"
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = avbp_home+"/HOST/BTMCLX2/AVBPEXEC/AVBP_CURRENT.BTMCLX2 > avbp_log.txt"
+
+        
+        ##########
+        # YALES2 #
+        ########## 
+	if appli in ["yales2_1007","yales2_1008"] :
+	  #Handle Version YALES TODO
+	  if command == "-c3sm_YALES2_auto_exe-":
+	    appli_keyword = "yales2"	
+	    # Execute in execDirectory
+	    os.chdir(execDirectory)																	
+	    XDR.execute("make")
+	    XDR.execute("mkdir dump")
+	    XDR.execute("mkdir postprocdump")				
+	    XDR.execute("touch warning.log")
+	    os.chdir(local_directory)
+	    print local_directory
+#############################################################################################################################
+#############################################################################################################################
+#############################################################################################################################
+
+
+        #####################
+        # SECTION FOR ALL APPLICATIONS
+        ####################
+
+
+        # Creating soumi.cmd
+
+
+        batchfile = open('soumi.cmd', 'w')
+        batchfile.write("FICH_IN="+local_directory+"/run_c3sm.tar\n")
+        batchfile.write("FICH_OUT=./"+execDirectory+".tar\n")
+        batchfile.write("EXECUTABLE="+command_exe+"\n")
+        batchfile.write("PREEXEC= module load apps/python_epd-6.3.2 ;mkdir "+project_name+"; cd "+project_name+"; mv ../run_c3sm.tar . ;tar xvf run_c3sm.tar;rm -f run_c3sm.tar\n")
+        batchfile.write("POSTEXEC=tar -cvf "+execDirectory+".tar ./\n")
+        batchfile.close()
+        self.dir2send.append('soumi.cmd')
+        
+        # create a tar archive of the directories list
+        XDR.execute("tar cvf run_c3sm.tar "+" ".join(self.dir2send))
+
+        # Creating soumi command
+        if self.external==0:
+            externe = ""
+        else:
+            externe = "combustion "
+
+        commandContent= "soumi -t "+self.duration+" -m "+self.memory+" -n "+self.nbprocs+" "+appli_keyword+" "+"soumi.cmd"
+        # feeback on command soumi
+        print "Commande soumi : "+commandContent
+        XDR.execute(commandContent)
+
+
+    
+    def retrieveDirectory(self,directory):
+        """ This command retrieves directory in current local directory
+        """
+        # uncompress archive
+        XDR.execute("mv "+directory+".tar ./"+ directory +"/")
+        os.chdir(directory)        
+        XDR.execute("tar   -xvf  "+directory+".tar")
+       
+        pass
+     
+    def removeDirectory(self,directory):
+        """ This command delete distant directory, if directory is "*", delete the project directory"""
+        pass
+        
+    def getInfos(self):
+        """ This method returns informations 
+        """
+        
+        self.infos['platform'] = "UNIX"
+        self.infos['parallelCommand'] = "mpirun -np "+XDR.getValue("nbprocs","unix_soumi",self.type+"_plugins","config")+" "
+        return self.infos
+        
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_ccrt_ssh.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_ccrt_ssh.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/turbomeca_ccrt_ssh.py	(revision 4775)
@@ -0,0 +1,142 @@
+import os,XDR,shutil
+
+MAIN_DIRECTORY_NAME = "C3Sm_projects"
+
+class turbomeca_ccrt_ssh(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+	 """ This method built a new instance of plugin.
+        First it constructs the plugin thanks to mother class : XDR.Plugin"""
+	
+        XDR.Plugin.__init__(self, typePlugin)
+                
+        self.login = self.getPluginParam("login") 
+        self.machinecea = self.getPluginParam("machinecea") 
+        self.nbprocs = self.getPluginParam("nbprocs") 
+        self.timelimit =  self.getPluginParam("timelimit") 
+        self.distantDirectory = self.getPluginParam("distantdir")    
+        self.mail = self.getPluginParam("mail")         
+        
+        if self.machinecea == "curie":
+             self.machine = "curie-ccrt.ccc.cea.fr"
+             self.platformname = "CURIE"
+        if self.machinecea == "airain":
+             self.machine = "airain.ccc.cea.fr"
+             self.platformname = "AIRAIN"
+
+        sshCommand = """bash -i -c "cd """+self.distantDirectory+"""; if [ ! -d """+MAIN_DIRECTORY_NAME+""" ] ; then mkdir """+MAIN_DIRECTORY_NAME+""" ; fi" """  
+
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,MAIN_DIRECTORY_NAME)
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+XDR.getValue("name","project","meta")+""" ] ; then mkdir """+XDR.getValue("name","project","meta")+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,XDR.getValue("name","project","meta"))
+        
+            
+    # Applications supportes 
+    @XDR.supported_applications(['avsp52','yales2_1007','yales2_1008'])
+    def executeDistantCommand(self,command,execDirectory,appli,flags=[]):       
+        """ This command executes command in execDirectory on distant machine.
+        Flags can be specified, they depend on the code and the plugin
+        """
+
+        batchContent =  "#!/bin/bash\n"
+        batchContent+=  "source /etc/profile.d/modules.sh\n"
+        batchContent+=  "#MSUB -r "+XDR.getValue("name","project","meta")+"\n"
+        batchContent+=  "#MSUB -n "+self.nbprocs+"\n"
+        batchContent+=  "#MSUB -T "+self.timelimit+"\n"
+        batchContent+=  "#MSUB -q standard\n"
+        batchContent+=  "#MSUB -o "+XDR.getValue("name","project","meta")+"%I.o\n"
+        batchContent+=  "#MSUB -e "+XDR.getValue("name","project","meta")+"%I.e\n"
+        batchContent+=  "#MSUB -@ "+self.mail+"\n"
+        batchContent+=  "#MSUB -q standard\n"
+
+################################################################################################################################
+################################################################################################################################
+################################################################################################################################
+        ########
+        # AVSP #
+        ########
+
+        if appli == "avsp52":
+            homeAVSP52="/ccc/work/cont001/turbomec/lederlin/codes/avsp/AVSP_V5.2"
+            batchContent += "module load hdf5/1.8.5\n"
+            avsp_command = "ccc_mprun -x -n "+ self.nbprocs+" "+homeAVSP52+"/AVSP.exe"
+
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "cp "+homeAVSP52+"/quiet3.py . ; " + pythonexec + " ./quiet3.py &> ./quiet.out"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = homeAVSP52+"/Anozzle.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+        #########
+        # YALES #
+        #########
+
+
+        if appli in ["yales2_1007","yales2_1008"] :
+            if appli == "yales2_1007" :
+                version_yales2 = " "
+            if appli == "yales2_1008" :
+                version_yales2 = "v_1.0.0.8"
+			
+			batchContent +="# PROLOGUE \n "
+			batchContent +="module load hdf5/1.8.5 \n "
+			batchContent +="module load parmetis \n "
+			batchContent +="module load fftw3 \n "
+			batchContent +="module load scotch \n "
+			batchContent +="module load petsc/3.2-p7_real \n "
+			batchContent +="module load slepc/3.2-p4 \n "
+			
+			batchContent +="make \n "
+			batchContent +="mkdir dump \n "
+			batchContent +="mkdir postprocdump \n "
+			
+			batchContent +="set -x \n "
+			command_exe = "ccc_mprun -x -n "+self.nbprocs+" ./caseYales2"
+
+
+
+################################################################################################################################
+################################################################################################################################
+################################################################################################################################
+
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+
+        batchContent +=command_exe+"\n"
+ 
+        batchFile = open("batch_C3Sm_CCRT",'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+        
+        XDR.execute("scp -r batch_C3Sm_CCRT "+self.login+"@"+self.machine+":"+self.distantDirectory + "/" + execDirectory + "/")
+
+        sshCommand = """cd """+os.path.join(self.distantDirectory,execDirectory)+"""; ccc_msub batch_C3Sm_CCRT"""
+        
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        
+        
+    def retrieveDirectory(self,directory):
+        
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        # Retrieve Directory
+        shutil.rmtree(local_directory)
+        scpCommand = "scp -r "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+    
+        XDR.execute(scpCommand)
+        
+        
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+os.path.join(self.distantDirectory,"..")+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -r "+os.path.join(self.distantDirectory,directory)
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_corail.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_corail.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_corail.py	(revision 4775)
@@ -0,0 +1,132 @@
+import os
+import shutil
+import XDR
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class unix_corail(XDR.Plugin):
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        print "Using corail plugin, check in terminal if password is asked"
+        
+        self.login = self.getPluginParam("login")
+        self.machine = "corail"
+        self.nbprocs = self.getPluginParam("nbprocs")
+        self.dir2send = []
+        self.distantDirectory = self.getPluginParam("directory")
+        
+        # create the DISTANT_UNIX_DIRECTORY on the distant machine
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+DISTANT_UNIX_DIRECTORY+""" ] ; then mkdir """+DISTANT_UNIX_DIRECTORY+""" ; fi" """
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY)
+        
+        # then create the project_name folder if needed
+        project_name = XDR.getValue("name","project","meta")
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+project_name+""" ] ; then mkdir """+project_name+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,project_name)
+    
+    
+    # Applications supported
+    @XDR.supported_applications(['avsp52','avbp621','avtp2'])
+    
+    def executeDistantCommand(self,command,execDirectory,appli, flags=[]):       
+        
+        execDir_abspath = os.path.join(self.distantDirectory,execDirectory)
+        
+        print "Running executeDistantCommand "+command+" in "+execDirectory+" for appli"+appli
+        ########
+        # INITS
+        ########
+        command_exe = command
+        appli_keyword = "none"
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+
+        # Creating batch file
+        batchContent = [
+                "#!/bin/bash",
+                "#PBS -N C3Sm",
+                "#PBS -j oe",
+                "#PBS -l select=" + self.getPluginParam("nbprocs"),
+                "#PBS -l walltime=06:00:00",
+                "",
+                "cat $PBS_NODEFILE",
+                "nb_cpu=$(wc -l < $PBS_NODEFILE)",
+                "",
+                "cd $PBS_O_WORKDIR",
+                "source /usr/local/bin/intelmpi.sh"]
+               
+############################################################################
+############################################################################
+############################################################################
+                    
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "/usr/local/bin/python /home/rolex/AVSP/avsp53/quiet3.py &> ./quiet.out"
+                avsp_command = "mpirun -np "+self.nbprocs+ " /home/rolex/AVSP/avsp53/AVSP_V5.3.CORAIL"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = "/home/rolex/AVSP/avsp53/Anozzle_CORAIL.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+                    
+        ########
+        # AVBP #
+        ########
+        if appli == "avbp621":
+            batchContent.append("export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH")
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVBP_V6.X/AVBP_D6.2.1/AVBP_V6.2.1_beta.CORAIL > avbp_log.txt"
+                
+        ########
+        # AVTP #
+        ########
+        if appli == "avtp2":
+            if command == "-c3sm_auto_avtp_exe-":
+                command_exe = "mpirun -np $nb_cpu /home/rolex/AVTP/avtp2/AVTP_V2.X.CORAIL > avtp_log.txt"
+                
+############################################################################
+############################################################################
+############################################################################
+
+        if command_exe.startswith("-c3sm_auto_"):
+            XDR.error("command was not understood: "+command_exe )
+
+        batchContent.append(command_exe)
+        
+        batchFile = open(os.path.join(XDR.getCurrentRun(), "batch_C3Sm_CORAIL"), 'w')
+        batchFile.write("\n".join(batchContent))
+        batchFile.close()
+
+        # create a zip archive of the directories list
+        print "Final composition of c3sm_archive:"
+        print self.dir2send
+        
+        XDR.ssh_send(self.machine,self.login, self.distantDirectory, self.dir2send, options="")   
+        
+        sshCommand = "cd {0}; /opt/pbs/default/bin/qsub batch_C3Sm_CORAIL".format(execDir_abspath)
+        XDR.ssh(self.machine,self.login, sshCommand, options="")
+       
+ 
+    def retrieveDirectory(self,directory):
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        XDR.ssh_retrieve(self.machine, self.login, self.distantDirectory+"/"+dist_directory, local_directory )
+
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+self.distantDirectory+"/.. "+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -rf "+self.distantDirectory+"/"+directory
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+    
+    def getRunsState(self):
+        pass
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_curie.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_curie.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_curie.py	(revision 4775)
@@ -0,0 +1,107 @@
+import os,XDR,shutil
+
+MAIN_DIRECTORY_NAME = "C3Sm_projects"
+
+class unix_curie(XDR.Plugin):
+    
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        print "Using curie plugin"
+        try :
+            self.login = XDR.getValue("login","unix_curie",self.type+"_plugins","config")
+            self.machinecea = XDR.getValue("machinecea","unix_curie",self.type+"_plugins","config")
+            self.nbprocs = XDR.getValue("nbprocs","unix_curie",self.type+"_plugins","config")
+            self.timelimit = XDR.getValue("timelimit","unix_curie",self.type+"_plugins","config")
+            self.distantDirectory = XDR.getValue("distantdir","unix_curie",self.type+"_plugins","config")
+        except XDRnoNodeException:
+            XDR.error("Some values are missing in the configuration of plugin unix_curie")
+        
+        if self.machinecea == "curie":
+             self.machine = "curie-ccrt.ccc.cea.fr"
+        if self.machinecea == "airain":
+             self.machine = "airain.ccc.cea.fr"
+
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+MAIN_DIRECTORY_NAME+""" ] ; then mkdir """+MAIN_DIRECTORY_NAME+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,MAIN_DIRECTORY_NAME)
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+XDR.getValue("name","project","meta")+""" ] ; then mkdir """+XDR.getValue("name","project","meta")+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,XDR.getValue("name","project","meta"))
+    
+    def sendDirectory(self,directory):
+
+        
+        local_directory = os.path.abspath(directory)
+        directory_basename = os.path.basename(local_directory)
+        
+        if os.path.exists(local_directory):
+            pass
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+      
+        print "scp -r "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory + "/"
+        XDR.execute("scp -r "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory + "/")
+        print "done"
+        
+    def executeDistantCommand(self,command,execDirectory,flags=[]):       
+        
+        # Creating batch file
+        batchContent =  """#!/bin/bash
+#MSUB -r """+XDR.getValue("name","project","meta")+"""
+#MSUB -n """+self.nbprocs+"""
+#MSUB -T """+self.timelimit+"""
+#MSUB -q standard
+#MSUB -o %I.o
+#MSUB -e %I.e
+
+source /etc/profile.d/modules.sh
+
+"""
+        if "mpi" in flags:
+            batchContent +=""
+        
+        if ("hdf185" in flags) or ("hdf5" in flags):
+            batchContent += "module load hdf5/1.8.5\n"
+        
+        batchContent += """cd """+os.path.join(self.distantDirectory,execDirectory)+"\n"
+        
+        if "nompirun" in flags:
+            batchContent+=command+"\n"
+        else:
+            batchContent+="mpirun "+command+"\n"
+        
+        batchFile = open("batch_C3Sm_CCRT",'w')
+        batchFile.write(batchContent)
+        batchFile.close()
+        
+        XDR.execute("scp -r batch_C3Sm_CCRT "+self.login+"@"+self.machine+":"+self.distantDirectory + "/" + execDirectory + "/")
+        
+        sshCommand = """cd """+os.path.join(self.distantDirectory,execDirectory)+"""; ccc_msub batch_C3Sm_CCRT"""
+        
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        
+        
+    def retrieveDirectory(self,directory):
+        
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        # Retrieve Directory
+        shutil.rmtree(local_directory)
+        scpCommand = "scp -r "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+    
+        XDR.execute(scpCommand)
+        
+        
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+os.path.join(self.distantDirectory,"..")+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -r "+os.path.join(self.distantDirectory,directory)
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_neptune.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_neptune.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/pluginscripts/unix_neptune.py	(revision 4775)
@@ -0,0 +1,228 @@
+import os,XDR,shutil
+
+
+DISTANT_UNIX_DIRECTORY = "C3Sm_projects"
+
+class unix_neptune(XDR.Plugin):
+    def __init__(self,typePlugin):
+        XDR.Plugin.__init__(self, typePlugin)
+        
+        print "Using  neptune plugin, check in terminal if password is asked"
+        
+        self.login = self.getPluginParam("login")
+        self.machine = "neptune"
+        self.nbnodes = self.getPluginParam("nbnodes")
+        self.dir2send = []
+        self.distantDirectory = self.getPluginParam("directory")
+        
+        # create the DISTANT_UNIX_DIRECTORY on the distant machine
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+DISTANT_UNIX_DIRECTORY+""" ] ; then mkdir """+DISTANT_UNIX_DIRECTORY+""" ; fi" """
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,DISTANT_UNIX_DIRECTORY)
+        
+        # then create the project_name folder if needed
+        project_name = XDR.getValue("name","project","meta")
+        sshCommand = """bash -c "cd """+self.distantDirectory+"""; if [ ! -d """+project_name+""" ] ; then mkdir """+project_name+""" ; fi" """    
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        self.distantDirectory = os.path.join(self.distantDirectory,project_name)
+    
+    def sendDirectory(self,directory):
+
+        
+        local_directory = os.path.abspath(directory)
+        directory_basename = os.path.basename(local_directory)
+        
+        if os.path.exists(local_directory):
+            pass
+        else:
+            raise Exception("Error : "+directory+" doesn't exist")
+        # Je te met un exemple avec un scp (avec account et machine definis dans le init:
+        self.dir2send.append(directory)
+        print "Adding "+directory +" to the list of folders for the archive"
+        print self.dir2send
+      
+        #XDR.execute("scp -pr "+local_directory+" "+self.login+"@"+self.machine+":"+self.distantDirectory + "/")
+        
+        
+    def executeDistantCommand(self,command,execDirectory,appli, flags=[]):       
+        
+        execDir_abspath = os.path.join(self.distantDirectory,execDirectory)
+        
+        print "Running executeDistantCommand "+command+" in "+execDirectory+" for appli"+appli
+        ########
+        # INITS
+        ########
+        command_exe = command
+        appli_keyword = "none"
+        supported_applis = []
+        local_directory = os.getcwd()
+        project_name = XDR.getValue("name","project","meta")
+        #project_name = "NOM_PROJET"
+        
+        
+        # Creating batch file
+        batchContent =  """#!/bin/bash
+#PBS -N C3Smjob
+#PBS -l walltime=06:00:00
+#PBS -j oe
+#PBS -l select="""+self.getPluginParam("nbnodes")+"""
+#PBS -m ae
+
+cat \$PBS_NODEFILE
+nb_cpu=\$(wc -l < \$PBS_NODEFILE)
+
+        
+cd """+execDir_abspath+"""
+"""       
+        
+        #####################
+        # SECTION DEPENDING ON APPLICATIONS
+        ####################
+        supported_applis.append("avsp52") 
+        supported_applis.append("avbp621")
+        supported_applis.append("avbp70")
+        supported_applis.append("avtp2")
+        supported_applis.append("aap01")
+        if appli not in supported_applis:
+            XDR.error("this application requires the application tag "+ appli+ ", which is not supported by the plugin unix_neptune.")
+            return
+               
+               
+                    
+        ########
+        # AVSP #
+        ########
+        if appli == "avsp52":
+            if command == "-c3sm_auto_avsp_exe-":
+                command_exe = "cd "+ execDir_abspath+" ; cp /home/rolex/AVSP/avsp53/quiet3.py . ; /usr/bin/python ./quiet3.py &> ./quiet.out"
+                avsp_command = "mpirun -np "+self.nbnodes+ " /home/rolex/AVSP/avsp53/AVSP_V5.3.CORAIL"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_avsp_exe-",avsp_command)
+                anozzle_command = "/home/rolex/AVSP/avsp53/Anozzle_CORAIL.exe"
+                XDR.replace_pattern_in_file(os.path.join(execDirectory,"user_params.py"),"-c3sm_auto_anozzle_exe-",anozzle_command)
+                    
+        ########
+        # AVBP #
+        ########
+        if appli == "avbp621":
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = "/home/rolex/AVBP_V6.X/AVBP_D6.2.1/AVBP_V6.2.1_beta.NEPTUNE > avbp_log.txt"
+
+        if appli == "avbp70":
+            if command == "-c3sm_auto_avbp_exe-":
+                command_exe = "/home/rolex/AVBP_V6.X/AVBP_D7.0/AVBP_V7.0_beta.NEPTUNE > avbp_log.txt"                
+        ########
+        # AVTP #
+        ########
+        if appli == "avtp2":
+            if command == "-c3sm_auto_avtp_exe-":
+                command_exe = "/home/rolex/AVTP_V2.X/AVTP_V2.X.NEPTUNE > avtp_log.txt"
+                
+                
+        ###################
+        # AAP : AVBP-AVTP #
+        ###################
+        if appli == "aap01":
+            if command == "-c3sm_auto_aap_exe-":
+                batchContent +="""
+module load compiler/intel mpi/intelmpi
+
+export NBPROC_main_avtp="""+self.getPluginParam("nbcavtp")+"""
+export NBPROC_main_avbp="""+self.getPluginParam("nbcavbp")+"""
+palm_main=/home/rolex/AAP/AVBP_AVTP/palm_main
+main_avtp=/home/rolex/AAP/AVBP_AVTP/main_avtp
+main_avbp=/home/rolex/AAP/AVBP_AVTP/main_avbp
+cp /home/rolex/AAP/AVBP_AVTP/avbp_avtp.pil .
+"""
+                command_exe = " -np 1 \$palm_main : -np \$NBPROC_main_avtp \$main_avtp : -np \$NBPROC_main_avbp \$main_avbp > cpl_log.txt"  
+        
+        ######################
+        # AAP : AVBP-PRISSMA #
+        ######################
+        if appli == "aap02":
+            if command == "-c3sm_auto_aap_exe-":
+                batchContent +="""
+module load compiler/intel mpi/intelmpi
+
+export NBPROC_main_prissma="""+self.getPluginParam("nbcprissma")+"""
+export NBPROC_main_avbp="""+self.getPluginParam("nbcavbp")+"""
+palm_main=/home/rolex/AAP/AVBP_AVTP/palm_main
+main_avtp=/home/rolex/AAP/AVBP_AVTP/main_prissma
+main_avbp=/home/rolex/AAP/AVBP_AVTP/main_avbp
+cp /home/rolex/AAP/AVBP_AVTP/avbp_prissma.pil .
+"""
+                command_exe = " -np 1 \$palm_main : -np \$NBPROC_main_prissma \$main_prissma : -np \$NBPROC_main_avbp \$main_avbp > cpl_log.txt"  
+        
+        ###########################
+        # AAP : AVBP-AVTP-PRISSMA #
+        ###########################
+        if appli == "aap03":
+            if command == "-c3sm_auto_aap_exe-":
+                batchContent +="""
+module load compiler/intel mpi/intelmpi
+
+export NBPROC_main_prissma="""+self.getPluginParam("nbcprissma")+"""
+export NBPROC_main_avbp="""+self.getPluginParam("nbcavbp")+"""
+export NBPROC_main_avtp="""+self.getPluginParam("nbcavtp")+"""
+palm_main=/home/rolex/AAP/AVBP_AVTP/palm_main
+main_avtp=/home/rolex/AAP/AVBP_AVTP/main_avtp
+main_avbp=/home/rolex/AAP/AVBP_AVTP/main_avbp
+main_avtp=/home/rolex/AAP/AVBP_AVTP/main_prissma
+cp /home/rolex/AAP/AVBP_AVTP/avbp_avtp_prissma.pil .
+"""
+                command_exe = " -np 1 \$palm_main : -np \$NBPROC_main_prissma \$main_prissma : -np \$NBPROC_main_avtp \$main_avtp : -np \$NBPROC_main_avbp \$main_avbp > cpl_log.txt" 
+
+
+        if appli == "avbp621":
+            batchContent +="""export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH"""+"\n"
+        batchContent+="mpirun "+command_exe+"\n"
+
+        if appli == "avbp70":
+            batchContent +="""export LD_LIBRARY_PATH=/home/cfd/avbp/LIBSUPPORT:$LD_LIBRARY_PATH"""+"\n"
+        batchContent+="mpirun "+command_exe+"\n"        
+      
+        
+        # create a zip archive of the directories list
+        print "Final composition of c3sm_archive:"
+        print self.dir2send
+        #print "tar -cvf c3sm_archive.tar "+" ".join(self.dir2send)
+        XDR.execute("tar -cvf c3sm_archive.tar "+" ".join(self.dir2send))
+        
+        #sending archive
+        print "Sending archive..."
+        XDR.execute("scp -pr c3sm_archive.tar "+self.login+"@"+self.machine+":"+self.distantDirectory + "/")
+        
+        # extract archive
+        
+        sshCommand = "cd "+self.distantDirectory+" ; tar -xvf "+os.path.join(self.distantDirectory,"c3sm_archive.tar")
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        
+        sshCommand = """cd """+execDir_abspath+"""; echo " """+batchContent+""" " > batch_C3Sm_neptune ; qsub batch_C3Sm_neptune"""
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+        # back to the initial directory
+        os.chdir(local_directory)
+        
+    def retrieveDirectory(self,directory):
+        
+        local_directory = os.path.abspath(directory)
+        dist_directory = os.path.basename(local_directory)
+        # Retrieve Directory
+        shutil.rmtree(local_directory)
+        scpCommand = "scp -pr "+self.login+"@"+self.machine+":"+self.distantDirectory+"/"+dist_directory+" "+os.path.dirname(local_directory)
+    
+        XDR.execute(scpCommand)
+        
+        
+    def removeDirectory(self,directory):
+        if directory == "*":
+            sshCommand = """bash -c "cd """+self.distantDirectory+"/.. "+"""; if [ -d """+self.distantDirectory+""" ] ; then rm -r """+self.distantDirectory+""" ; fi"
+            """
+        else:
+            sshCommand = "rm -rf "+self.distantDirectory+"/"+directory
+            
+        XDR.execute("ssh "+self.login+"@"+self.machine+" '"+sshCommand+"'")
+        
+    
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/cerfacs_neptune_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/cerfacs_neptune_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/cerfacs_neptune_local.xml	(revision 4775)
@@ -0,0 +1,10 @@
+<model name="cerfacs_neptune_local" title="Cerfacs, tools execution on supercomputer NEPTUNE" >
+<info name="nbprocs" title="Procs number" type="integer" default="1" visibility="hidden" />
+<desc>
+Execution at Cerfacs, on the supercomputer NEPTUNE.
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=cerfacs;caption=Cerfacs only]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/coria_anymachine_ssh.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/coria_anymachine_ssh.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/coria_anymachine_ssh.xml	(revision 4775)
@@ -0,0 +1,14 @@
+<model name="coria_anymachine_ssh" title="Coria, Code execution on any ssh machine" >
+    <param name="login" title="Login" type="ascii"  default="login"/>
+    <param name="machine" title="Machine" type="ascii" default="cobra" />
+    <param name="directory" title="working directory" type="ascii" default="~" />
+    <info name="nbprocs" title="number of processor" type="integer" default="1" visibility="hidden" />
+    <desc>
+        This plugin is for Coria only
+         Check that you can log on the distant machnine without password!!!
+[]
+[logo=plugin_ssh;caption=execution through ssh ]
+[]
+[logo=coria;caption=Coria only]
+</desc>
+    </model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/distant_unix.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/distant_unix.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/distant_unix.xml	(revision 4775)
@@ -0,0 +1,15 @@
+<model name="distant_unix" title="Cerfacs, Tool execution from External to NFS network" >
+    <param name="login" title="Login" type="ascii"  default="login"/>
+    <param name="machine" title="Machine" type="ascii" default="cobra" />
+    <param name="directory" title="working directory" type="ascii" default="/wkdir/cfd1/mylogin" />
+    <info name="nbprocs" title="Procs number" type="integer" default="1" visibility="hidden" />
+    <desc>
+        This plugin is for Cerfacs only
+        It allows to execute a tool from an external computer, typically a mac, or any computer NOT on the NFS system.
+         Check that you can log on the distant machnine without password!!!
+[]
+[logo=plugin_ssh;caption=execution through ssh ]
+[]
+[logo=cerfacs;caption=Cerfacs only]
+</desc>
+    </model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/folderParameters.xml	(revision 4775)
@@ -0,0 +1,1 @@
+<xor name="tool_plugins" title="Tool execution" default="no_plugin" groups="on" />
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/local_unix.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/local_unix.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/local_unix.xml	(revision 4775)
@@ -0,0 +1,11 @@
+<model name="local_unix" title="Cerfacs, tools execution on NFS network" >
+<info name="nbprocs" title="Procs number" type="integer" default="1" visibility="hidden" />
+<desc>
+Execution at Cerfacs, on the NFS network.
+Works for cobra, ptero , babylon, etc...
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=cerfacs;caption=Cerfacs only]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/no_plugin.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/no_plugin.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/no_plugin.xml	(revision 4775)
@@ -0,0 +1,6 @@
+<model name="no_plugin" title="No plugin" >
+<desc>
+No plug-in selected for tools.
+[logo=plugin_missing]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_windows2zephyr.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_windows2zephyr.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_windows2zephyr.xml	(revision 4775)
@@ -0,0 +1,13 @@
+<model name="snecma_windows2zephyr" title="Execution windows vers le robot zephyr" >
+<desc>
+    Ce profil est a l'usage de Safran Villaroche. Il permet de lancer des outils UNIX lors d'une execution de C3Sm sur Windows.
+    Les scripts shell avec une extension ".todo" seront executes par un robot pouvant tourner sur Zephyr 
+    
+    [item= Assurez vous que le robot est actif aupres du garant C3Sm de votre site.]
+    [item= Assurez vous que votre projets est construit sur le disque \\Windata]
+    []
+    [logo=plugin_robot;caption=execution par robot]
+    []
+    [logo=snecma;caption=Uniquement pour Snecma]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_zephyr_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_zephyr_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/snecma_zephyr_local.xml	(revision 4775)
@@ -0,0 +1,9 @@
+<model name="snecma_zephyr_local" title="Execution en local sur Zephyr" >
+<desc>
+Execution at Snecma, on Zephyr via vnc session.
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=snecma;caption=Snecma only]
+</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/turbomeca_btmclx2_local.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/turbomeca_btmclx2_local.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/DATA/tool_plugins/turbomeca_btmclx2_local.xml	(revision 4775)
@@ -0,0 +1,9 @@
+<model name="turbomeca_btmclx2_local" title="Turbomeca, tools on BTMCLX2" >
+<info name="nbprocs" title="Procs number" type="integer" default="1" visibility="hidden" />
+<desc>
+Execution at Turbomeca, on the cluster BTMCLX2
+[]
+[logo=plugin_local;caption=local execution]
+[]
+[logo=turbomeca;caption=Turbomeca only]</desc>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/blastransfo.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/blastransfo.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/blastransfo.xml	(revision 4775)
@@ -0,0 +1,40 @@
+ <model name="transfblas" title="Blasold or Blasnew transformations" layout="flat">
+     <desc>
+Please enter if there is a multiplication and/or addition by a scalar, for the different coupling fields,
+selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+     </desc>
+</model>
+ <model name="transfblon" title="Blasold/Blasnew" layout="flat">
+    <multiple name="multaddoldnew" title="Blasold/Blasnew options" require="field_names_list" custom_label="Fields">
+         <xor name="blasold" title="BLASOLD" default="blasold_off">
+	   <model name="blasold_off" title="No BLASOLD">
+           </model>
+	   <model name="blasold_on" title="BLASOLD">
+	     <param name="xmult_blso" title="Multiplicative coef (real)" type="double" default="1."/>
+	     <param name="xadd_blso" title="Scalar value to be added (real)" type="double" default="0."/>	     
+           </model>
+         </xor>
+         <xor name="blasnew" title="BLASNEW" default="blasnew_off">
+	   <model name="blasnew_off" title="No BLASNEW">
+           </model>
+	   <model name="blasnew_on" title="BLASNEW">
+	     <param name="xmult_blsn" title="Multiplicative coef (real)" type="double" default="1."/>
+	     <param name="xadd_blsn" title="Scalar value to be added (real)" type="double" default="0."/>	     
+           </model>
+         </xor>
+	 </multiple>
+    <docu>
+
+[section=BLASOLD]
+
+BLASOLD allows the source field to be scaled and allows a scalar to be added to the field. 
+This transformation occurs before the interpolation per se. 
+
+[section=BLASNEW]
+
+BLASNEW performs a scalar multiply or scalar add to any destination field. This is the equivalent of BLASOLD 
+on the destination side. 
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/blastransfo/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Blasold/new" order="90" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/checkinout.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/checkinout.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/checkinout.xml	(revision 4775)
@@ -0,0 +1,40 @@
+ <model name="cicotransfo" title="Checkin Checkout operations" layout="flat">
+   <desc>
+Please enter if the min and the max of the coupling fields must be calculated (it is recommended), 
+for the different coupling fields, selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+   </desc>
+</model>
+ <model name="transfcico" title="Checkin/Checkout" layout="flat">
+   <multiple name="checkinoutminmax" title="Checkin/Checkout options" require="field_names_list" custom_label="Fields">
+         <xor name="checkin" title="CHECKIN" default="checkin_off">
+	   <model name="checkin_off" title="No CHECKIN">
+           </model>
+	   <model name="checkin_on" title="CHECKIN">
+           </model>
+         </xor>
+         <xor name="checkout" title="CHECKOUT" default="checkout_off">
+	   <model name="checkout_off" title="No CHECKOUT">
+           </model>
+	   <model name="checkout_on" title="CHECKOUT">
+           </model>
+         </xor>
+    </multiple>
+    <docu>
+
+[section=CHECKIN]
+
+Calculates the global minimum, the maximum and the sum of the source field 
+values and prints them to the OASIS3-MCT debug file. These 
+informations are found in the debug file of the master process of the source model 
+under the attribute ``diags''. This operation does not transform the field.
+
+[section=CHECKOUT] 
+  
+Calculates the global minimum, the maximum and the sum of the target field values 
+and prints them to the OASIS3-MCT debug file. These informations are 
+found in the debug file of the master process of the target model under the attribute ``diags''. 
+This operation does not transform the field.
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/checktransfo/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Min/Max" order="80" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/conserv.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/conserv.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/conserv.xml	(revision 4775)
@@ -0,0 +1,69 @@
+ <model name="conservtransfo" title="Conservation transformation" layout="flat">
+     <desc>
+Please define the redistribution, if any, for the different coupling fields
+selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+     </desc>
+ </model>
+ <model name="transfconserv" title="Conservation option" layout="flat">
+    <multiple name="conservation" title="Conserv option" require="field_names_list" custom_label="Fields">
+         <xor name="conservopt" title="Conserv or not" default="conserv_off">
+	   <model name="conserv_off" title="NO CONSERV">
+	   </model>
+	   <model name="conserv_on" title="CONSERV">
+	     <choice name="conservstrategy" title="How to do the redistribution" type="string" default="global">
+               <option value="global" title="GLOBAL"/>
+               <option value="glbpos" title="GLBPOS"/>
+               <option value="basbal" title="BASBAL"/>
+               <option value="baspos" title="BASPOS"/>
+	     </choice>
+	     <choice name="conservalgo" title="Algorithm" type="string" default="bfb_conserv_on">
+	       <option value="bfb_conserv_on" title="Bit-for-bit reproductibility"/>
+               <option value="opt_conserv_on" title="Optimized"/>
+	     </choice>
+           </model>
+	 </xor>
+       </multiple>
+    <docu> 
+[section=CONSERV option]
+CONSERV ensures a global modification of the coupling field. This analysis requires the source and target 
+grid mesh areas to be transfered to the coupler with oasis_write_area and oasis_write_mask. For a correct 
+CONSERV operation, overlapping grid cells on the source grid or on the target grid must be masked. [] 
+
+[section=Types of redistribution]
+The following types of options are available: []
+- GLOBAL, the field is integrated on both source and target grids, without considering values of masked points, 
+and the residual (target - source) is uniformly distributed on the target grid; this option ensures 
+global conservation of the field []
+- GLBPOS, the same operation is performed except that the residual is distributed proportionally to the value 
+of the original field; this option ensures the global conservation of the field and does not change 
+the sign of the field []
+- BASBAL, the operation is analogous to GLOBAL except that the non masked surface of the source and the 
+target grids are taken into account in the calculation of the residual; this option does not ensure global 
+conservation of the field but ensures that the energy received is proportional to the non masked surface 
+of the target grid []
+- BASPOS, the non masked surface of the source and the target grids are taken into account and the residual 
+is distributed proportionally to the value of the original field; therefore, this option does not ensure 
+global conservation of the field but ensures that the energy received is proportional to the non masked 
+surface of the target grid and it does not change the sign of the field. []
+
+More information is available in the User Guide section 4.4.
+
+<docuold>
+[section=Algorithm]
+The algorithm used to perform the redistribution can be "Bit-for-bit reproductibility" (bfb) 
+or "Optimized" (opt). The bfb option enforces a bit-for-bit transformation regardless of 
+the grid decomposition or process count. The opt option carries out the conservation using an optimal algorithm 
+using less memory and a faster approach. Option bfb is the default setting.
+</docuold>
+    </docu>
+</model>
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/conservtransof/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Cons" order="120" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/cplrststatus.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/cplrststatus.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/cplrststatus.xml	(revision 4775)
@@ -0,0 +1,85 @@
+ <model name="fldproper" title="Coupling fields properties" layout="flat">
+  <desc> 
+Please enter the coupling period, the name of the restart files and the status for 
+the different coupling fields, selecting the different rows available.
+If you have many fields, it is possible to propagate the properties of one field 
+to the others using the button "copy". 
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up, specially on the
+INPUT and OUTPUT field properties.
+  </desc>
+ </model>
+
+ <model name="cplrststatus" title="Coupling fields properties" layout="flat">
+    <multiple name="crs" title="Coupling period, restarts, status" require="field_names_list" custom_label="Fields" size="1.5;1.5">
+         <param name="cpl" title="Coupling or IO period in s (integer)" type="integer" />
+         <param name="restart" title="Restart file (NetCDF)" type="string" />
+         <choice name="status" title="Status" type="string" default="exported">
+               <option value="exported" title="EXPORTED"/>
+               <option value="expout" title="EXPOUT"/>
+               <option value="input" title="INPUT"/>
+               <option value="output" title="OUTPUT"/>
+         </choice>
+    </multiple>
+    <docu> 
+[section=NetCDF Restart files]
+The name of the coupling restart file for the field is mandatory even if no coupling restart file is effectively used. []
+
+More information on the restart files can be found in the User Guide section 2.10 and section 5.2.
+
+[section=Status of the fields]
+[item=EXPORTED:] The field is exchanged between component models and transformed by OASIS3-MC
+[item=EXPOUT:] The field is exchanged, transformed and also written to two debug NetCDF files (after LOCTRANS and BLASOLD before 
+remapping and after all transformations after remapping).
+[item=INPUT:] The field is read in from the input file by the target model.
+[item=OUTPUT:] The field is written out to an output debug NetCDF file by the source model. 
+
+More information is available in section 3.3 of the User Guide.
+
+<docuold>
+[section=NetCDF Restart files]
+The name of the coupling restart file for the field is mandatory even if no coupling restart file is effectively used. []
+
+At the beginning of a coupled run, some coupling fields may have to be initially read from their coupling restart 
+file on their source grid. When needed, these files are also automatically updated by the last active oasis_put 
+call of the run. Warning: the date is not written or read to/from the restart file; therefore, the 
+user has to make sure that the appropriate coupling restart file is present in the working directory. The coupling 
+restart files must follow the NetCDF format. []
+
+Coupling fields coming from different models cannot be in the same coupling restart files, 
+but for each model, there can be an arbitrary number of fields written in one coupling restart file. The only exception 
+is when a coupling field sent by a source component model is associated with more than one target field and model; 
+in that case, if coupling restart files are required, it is mandatory to specify different files for the different fields. []
+
+In the coupling restart files, the fields must be provided on the source grid in single or double precision REAL arrays and, 
+as the grid data files, must be dimensioned (nx, ny), where nx and ny are the grid first and second dimension. The shape and 
+orientation of each restart field (and of the corresponding coupling fields exchanged during the simulation) must be coherent 
+with the shape of its grid data arrays. []
+
+The coupling restart files are also used automatically by OASIS3-MCT to allow partial LOCTRANS time transformation 
+to be saved at the end of a run for exact restart at the start of the next run. For that reason, coupling restart 
+filenames are now required for all namcouple transformations that use LOCTRANS (with non INSTANT values).
+
+[section=Status of the fields]
+The field may be : []
+- EXPORTED: exchanged between component models and transformed by OASIS3-MCT []
+- EXPOUT: exchanged, transformed and also written to two debug NetCDF files, one before the sending action in 
+the source model below the oasis_put call (after local transformations LOCTRANS and BLASOLD if present), and one 
+after the receiving action in the target model below the oasis_get call (after all transformations). EXPOUT should 
+be used when debugging the coupled model only. The name of the debug NetCDF file (one per field) is automatically 
+defined based on the field and component model names. []
+- INPUT: read in from the input file by the target model below the oasis_get call at appropriate times corresponding 
+to the input period indicated by the user in the namcouple. []
+- OUTPUT: written out to an output debug NetCDF file by the source model below the oasis_put call, after local
+transformations LOCTRANS and BLASOLD, at appropriate times corresponding to the output period indicated by 
+the user in the configuration file. 
+</docuold>
+    </docu>
+</model>
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/cplrststatus/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Fld status" order="40" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/field.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/field.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/field.xml	(revision 4775)
@@ -0,0 +1,52 @@
+ <model name="flddesc" title="Coupling field names" layout="flat">
+  <desc> 
+Define here the coupling fields using the button "Add Coupling fields" 
+and double clicking in the new row created. A "user reference name" must be given to each
+coupling field under "Field label" by filling the part "no label" 
+and validated using the button "Enter" of the keyboard. This name will not appear in the namcouple and is only
+used by the GUI.
+The "load" button is useless for the OASIS3-MCT application.[] 
+For each field, the symbolic name used in the source model and the symbolic name used in the target model
+must be specified as well as the associated source and target grids.
+It is also necessary to specify for each field if it is grouped or not and to which group it belongs using the names 
+already defined in the Group window. 
+Only the source and target symbolic field names and grid names will appear in the namcouple configuration text file.[] 
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+  </desc>
+ </model>
+ <model name="fldname" title="Field names" layout="flat">
+    <multiple name="flddef" title="Coupling fields" custom_label="Field label" size="1.5;1.5">
+	     <info name="namefldgui" title="GUI Id (automatic)" default ="-"/>
+             <param name="fldnamebef" title="Source symbolic name" type="string" />
+             <choice name="srcgrid" title="Source grid" type="string" require="grid_names_list"/>
+	     <param name="fldnameaft" title="Target symbolic name" type="string" />
+             <choice name="tgtgrid" title="Target grid" type="string" require="grid_names_list"/>
+             <choice name="fldmult" title="Single or Group" default="single" require="mult_fields_name">
+             </choice>
+    </multiple>
+    <info name="field_names_list" title="List of the coupling fields" type="liststring" visibility="hidden"/> 
+    <docu>
+[section=Field names definition]
+In this window, you must enter  the coupling fields exchanged by all the models. 
+For each coupling field you must first enter a "user reference name" in the "no label" part.
+This "user reference name" is only used by the GUI and will not appear in the namcouple. 
+Then for each coupling field, you must enter the symbolic name of the field used in the source model 
+and the corresponding symbolic name of the field used in the target model. 
+These names will appear in the configuration file.[]  
+You must also specify for each field if it will be grouped or not and to which group it belongs using the names 
+already defined in the Group window. 
+
+If the field is read or written from/to a file, the target field name will be renamed automatically when writting the 
+configuration file as the source and target symbolic names must be identical. In this case no transformations or
+only LOCTRANS transformations are allowed. 
+
+More details on coupling fields are avalaible in the User Guide section 3.3 and section 5.3.
+    </docu>
+</model>
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/fielddef/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Fld Name" order="30" script="process_fielddef.py"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/folderParameters.xml	(revision 4775)
@@ -0,0 +1,1 @@
+<solver name="oasis3-mct" title="OASIS3-MCT Coupler" image="icon_small.gif" />
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Grids" order="14" script="process_grids.py"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/grids.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/grids.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/grids/grids.xml	(revision 4775)
@@ -0,0 +1,47 @@
+<model name="modelgrids" title="Grids" layout="flat">
+    <desc> 
+Enter the name and characteristics of the grids involved in the coupling 
+using the button "add Grids", double clicking on the new row created 
+and filling the part "no label" under "Grid names". 
+The name must be validated using the button "Enter" of the keyboard. 
+The dimensions of the grids are optional, but if they are specified for one grid, they 
+must be specified for all the grids. 
+The "load" button is useless for the OASIS3-MCT application.[]
+The blue (?), located at the right bottom of this window, gives more information on each data to fill up. 
+    </desc>
+</model>
+<model name="defgrids" title="Grid" layout="flat">
+    <multiple name="gridsline" title="Grids" custom_label="Grid names (4 char)" size="1.5;1.5">
+      <choice name="gridstatus" title="Characteristics" type="string" >
+	<option value="periodical_grid" title="PERIODICAL"/>
+	<option value="regional_grid" title="REGIONAL"/>
+      </choice>
+      <param name="grid_overlap" title="Overlapping points (integer)" type="integer" />
+         <xor name="dimsgrid" title="Dimensions" default="dims_off">
+	   <model name="dims_off" title="No dimensions specified">
+           </model>
+	   <model name="dims_on" title="Dimensions">
+	     <param name="ni_grid" title="Dimension in i (integer)" type="integer" />
+	     <param name="nj_grid" title="Dimension in j (integer)" type="integer" />	     
+           </model>
+         </xor>
+    </multiple> 
+    <info name="grid_names_list" title="List of the grids" type="liststring" visibility="hidden"/>
+    <docu>
+
+[section=Grids]
+
+[item=Name of the grids:] The source grid names and the target grid names, coded on 4 characters,
+correpond to the prefix of the source grid names and the
+target grid names in the grid data files grids.nc, masks.nc and areas.nc (see the section 2.3 and 5.1
+of the User for more details). 
+[item=Characteristics:] For each grid, Periodical and Regional 
+correspond to the grid first dimension characteristic
+[item=Overlapping points:] Overlapping points correspond to the 
+first dimension number of overlapping grid points.[]
+[item=Dimensions:] The arrays containing the grid information are dimensioned 
+(ni, nj), where ni and nj are the grid first and second dimension. Unstructured grids or other grids expressed with 1D 
+vectors are supported by setting ni to the total number of grid points and nj to 1. []
+
+</docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Group" order="20" script="process_groups.py" existif="#groups_onoff#==1"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/group.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/group.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/groups/group.xml	(revision 4775)
@@ -0,0 +1,37 @@
+<model name="groupedfld" title="Groups" layout="flat">
+  <desc>
+Please enter all the grouped field names that will be used
+by the GUI using the button "add groups" and double clicking in the different rows created.
+The name must be validated using the button "Enter" of the keyboard.
+This is a symbolic name used by the GUI to manage easily the fields of a same group.
+It will not appear in the configuration file. 
+The "load" button is useless for the OASIS3-MCT application.[] 
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+  </desc>
+</model>
+<model name="gpfld" title="Grouped fields" layout="flat" >
+  <multiple name="group" title="Groups" custom_label="Group names">
+      <comment name="group_comment" title="Group description (optional)" />
+  </multiple>
+    <docu>
+[section=Grouping coupling fields]
+OASIS3-MCT supports exchange of multiple fields via a single communication.
+In the component model codes, these fields are defined as usual, and sent (``put'') or received (``get'')
+one at a time.
+
+More details on this new functionality can be found in the User Guide, appendix B.2.4.
+
+<docuold>
+Inside OASIS3-MCT, the fields are stored and a
+single mapping and send or receive instruction is in fact executed for all fields.
+This is useful in cases where multiple fields have
+the same coupling transformations and to reduce communication costs by aggregating
+multiple fields into a single communication.
+The coupling fields must be sent and received in the same order as they are defined in the corresponding
+single entry of the namcouple.[]
+Note that if a LOCTRAN transformation is needed for these multiple fields, it is necessary to
+define one restart file per each group of fields. []
+</docuold>
+    </docu>
+</model>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="SCRIP" order="100"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/interp.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/interp.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/interpolation/interp.xml	(revision 4775)
@@ -0,0 +1,216 @@
+<model name="scriptransfo" title="SCRIP Interpolation" layout="flat">
+     <desc>
+Please enter if the remapping is done with the SCRIP library, for the different coupling fields,
+selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+     </desc>
+</model>
+<model name="transfinterp" title="Remapping" layout="flat">
+    <multiple name="interp" title="Scripr options" require="field_names_list" custom_label="Fields">
+        <xor name="scrip" title="SCRIPR" default="scrip_off">
+            <model name="scrip_off" title="NO SCRIP">
+            </model>
+            <model name="scrip_on" title="SCRIP">
+                <xor name="scriprinterp" title="Type of interpolation" default="bilinear">
+                    <model name="distwgt" title="DISTWGT">
+                        <choice name="cgrs_dist" title="Type of source grid" type="string">
+                            <option value="lr_dist" title="LR"/>
+                            <option value="d_dist" title="D"/>
+                            <option value="u_dist" title="U"/>
+                        </choice>
+                        <choice name="rest_dist" title="Search restriction type" type="string">
+                            <option value="latlon_dist" title="LATLON"/>
+                            <option value="latitude_dist" title="LATITUDE"/>
+                        </choice>
+                        <param name="nbin_dist" title="Nb of restriction bins (integer)" type="integer"/>
+                        <param name="nv_dist" title="Nb of neighbours used (integer)" type="integer"/>
+                        <desc> Distance weighted nearest-neighbour interpolation (N neighbours).
+                        </desc>
+                    </model>
+                    <model name="gauswgt" title="GAUSWGT">
+                        <choice name="cgrs_gaus" title="Type of source grid" type="string">
+                            <option value="lr_gaus" title="LR"/>
+                            <option value="d_gaus" title="D"/>
+                            <option value="u_gaus" title="U"/>
+                        </choice>
+                        <choice name="rest_gaus" title="Search restriction type" type="string">
+                            <option value="latlon_gaus" title="LATLON"/>
+                            <option value="latitude_gaus" title="LATITUDE"/>
+                        </choice>
+                        <param name="nbin_gauss" title="Nb of restriction bins (integer)" type="integer"/>
+                        <param name="nv_gauss" title="Nb of neighbours used (integer)" type="integer" />
+                        <param name="var_gauss" title="Weight given to the neighbour used" type="double"/>
+                        <desc> N nearest-neighbour interpolation weighted by their distance and a gaussian function.
+                               For D and U grids, the restriction bin must be one.
+                        </desc>
+                    </model>
+                    <model name="bilinear" title="BILINEAR">
+                        <choice name="cgrs_bili" title="Type of source grid" type="string" >
+                            <option value="lr_bili" title="LR"/>
+                            <option value="d_bili" title="D"/>
+                        </choice>
+                        <choice name="rest_bili" title="Search restriction type" type="string" >
+                            <option value="latlon_bili" title="LATLON"/>
+                            <option value="latitude_bili" title="LATITUDE"/>
+                        </choice>
+                        <param name="nbin_bili" title="Nb of restriction bins (integer)" type="integer"/>
+	                <desc> Bilinear interpolation. Only LATITUDE is possible with D source grid
+                        </desc>
+                    </model>
+                    <model name="bicubic" title="BICUBIC">
+                        <choice name="cgrs_bicu" title="Type of source grid" type="string">
+                            <option value="lr_bicu" title="LR"/>
+                            <option value="d_bicu" title="D"/>
+                        </choice>
+                        <choice name="rest_bicu" title="Search restriction type" type="string">
+                            <option value="latlon_bicu" title="LATLON"/>
+                            <option value="latitude_bicu" title="LATITUDE"/>
+                        </choice>
+                        <param name="nbin_bicu" title="Nb of restriction bins (integer)" type="integer"/>
+	                <desc> Bicubic interpolation. Only LATITUDE is possible with D source grid
+                        </desc>
+                    </model>
+                    <model name="conserv_interp" title="CONSERV">
+                        <choice name="cgrs_conserv" title="Type of source grid" type="string" >
+                            <option value="lr_conserv" title="LR"/>
+                            <option value="d_conserv" title="D"/>
+                            <option value="u_conserv" title="U"/>
+                        </choice>
+                        <choice name="rest_conserv" title="Search restriction type" type="string">
+                            <option value="latlon_conserv" title="LATLON"/>
+                            <option value="latitude_conserv" title="LATITUDE"/>
+                        </choice>
+                        <param name="nbin_conserv" title="Nb of restriction bins (integer)" type="integer" />
+                        <choice name="norm_conserv" title="Normalization option" type="string" >
+                            <option value="fracnnei_conserv" title="FRACNNEI"/>
+                            <option value="fracarea_conserv" title="FRACAREA"/>
+                            <option value="destarea_conserv" title="DESTAREA"/>
+                        </choice>
+                        <choice name="order_conserv" title="Order of the interpolation" type="string" >
+                            <option value="first_conserv" title="FIRST"/>
+                            <option value="second_conserv" title="SECOND"/>
+                        </choice>
+	                <desc> Conservative interpolation. 
+                        </desc>
+                    </model>
+                </xor> 
+            </model>
+        </xor>
+    </multiple>
+    <docu> 
+[section=SCRIP library]
+The SCRIP1.4 library gather the interpolation techniques offered by Los Alamos National Laboratory (Jones 1999). 
+The SCRIP library routines are in oasis3-mct/lib/scrip/src. See the documentation in oasis3-mct/doc/SCRIPusers.pdf for more 
+details on the interpolation algorithms. 
+
+
+When the SCRIP library performs a remapping, it first checks if the file containing the corresponding remapping weights 
+and addresses exists; if it exists, it reads them from the file; if not, it calculates them and store them in a file. 
+The file is created in the working directory and is called rmp_srcg_to_ tgtg_INTTYPE_NORMAOPT.nc, where srcg and tgtg 
+are the acronyms of respetively the source and the target grids, INTTYPE is the interpolation type, i.e. DISTWGT, GAUSWGT, 
+BILINEAR (not BILINEA as in OASIS3.3) or CONSERV -see below, and NORMAOPT is the normalization option, i.e. DESTAREA, 
+FRACAREA or FRACNNEI for CONSERV only -see below). One has to take care that the remapping file will have the same 
+name even if other details, like the grid masks, are changed. When reusing a remapping file, one has to be sure that 
+it was generated in exactly the same conditions than the ones it is used for. []
+
+More details on the types interpolations that are available can be found in the User Guide section 4.3.
+
+<docuold>
+The following types of interpolations are available: []
+
+[section=DISTWGT] 
+Performs a distance weighted nearest-neighbour interpolation (N neighbours). All types of grids are supported. []
+- Masked target grid points: the zero value is associated to masked target grid points. []
+- Non-masked target grid points having some of the N source nearest neighbours masked: a 
+nearest neighbour algorithm using the remaining non masked source nearest neighbours is applied. []
+- Non-masked target grid points having all of the N source nearest neighbours masked: by default, the 
+nearest non-masked source neighbour is used (logical ll_nnei hard-coded to .true. in 
+oasis3-mct/lib/scrip/src/remap_distwgt.F; same default behaviour as OASIS3.3). []
+
+[section=GAUSWGT] 
+Performs a N nearest-neighbour interpolation weighted by their distance and a gaussian function. All grid types are supported. []
+- Masked target grid points: the zero value is associated to masked target grid points. []
+- Non-masked target grid points having some of the N source nearest neighbours masked: a nearest neighbour 
+algorithm using the remaining non masked source nearest neighbours is applied. []
+- Non-masked target grid points having all of the N source nearest neighbours masked: by default, the nearest 
+non-masked source neighbour is used (logical ll_nnei hard-coded to .true. in oasis3-mct/lib/scrip/src/remap_gauswgt.F); 
+this is NOT the same default behaviour as OASIS3.3; to have the same default behaviour as in OASIS3.3, put ll_nnei=.false.. []
+
+[section=BILINEAR and BICUBIC] 
+BILINEAR performs an interpolation based on a local bilinear approximation (see details in chapter 4 of SCRIP 1.4 documentation SCRIPusers.pdf). 
+Logically-Rectangular (LR) and Reduced (D) source grid types are supported. []
+
+BICUBIC performs an interpolation based on a local bicubic approximation for Logically-Rectangular (LR) grids, 
+and on a 16-point stencil for Gaussian Reduced (D) grids. 
+Note that for Logically-Rectangular grids, 4 weights for each of the 4 enclosing source neighbours are required corresponding 
+to the field value at the point, the gradient of the field with respect to i, the gradient of the field with respect to j, 
+and the cross gradient with respect to i and j in that order. OASIS3-MCT will calculate the remapping weights and addresses 
+(if they are not already provided) but will not, at run time, calculate the two gradients and the cross-gradient of the 
+source field (as was the case with OASIS3.3). These 3 extra fields need to be calculated by the source code and transfered 
+as extra arguments of the oasis_put. []
+
+- Masked target grid points: the zero value is associated to masked target grid points. []
+- Non-masked target grid points having some of the source points normally used in the bilinear or bicubic 
+interpolation masked: a N nearest neighbour algorithm using the remaining non masked source points is applied. []
+- Non-masked target grid points having all bilinear or bicubic neighbours masked: by default, the nearest 
+non-masked source neighbour is used (ll_nnei hard-coded to .true. in oasis3-mct/lib/scrip/src/remap_bilinear.f, 
+remap_bicubic.f and remap_bicubic_reduced.f); this is not the same default behaviour as OASIS3.3; to have the same 
+default behaviour as in OASIS3.3, put ll_nnei=.false. in the appropriate routine. []  
+
+[section=CONSERV] 
+Performs 1st or 2nd order conservative remapping, which means that the weight of a source cell is proportional to 
+area intersected by the target cell (plus some other terms proportional to the gradient of the field in the longitudinal 
+and latitudinal directions for the second order). []
+
+Note that the grid corners have to given by the user in the grid data file grids.nc or by the code itself in the 
+initialisation phase by calling routine oasis_write_corner ; OASIS3-MCT will not attempt to automatically calculate 
+them as OASIS3.3. []
+
+The following types of normalisations are available: []
+- FRACAREA: The sum of the non-masked source cell intersected areas is used to NORMalise 
+each target cell field value: the flux is not locally conserved, but the flux value itself is reasonable. []
+- DESTAREA: The total target cell area is used to NORMalise each target cell field value even if it only 
+partly intersects non-masked source grid cells: local flux conservation is ensured, but unreasonable flux 
+values may result. []
+- FRACNNEI: as FRACAREA, except that at least the source nearest unmasked neighbour is used for unmasked 
+target cells that intersect only masked source cells. Note that a zero value will be assigned to a target 
+cell that does not intersect any source cells (masked or unmasked), even with FRACNNEI option. []
+
+For CONSERV/SECOND, 3 weigths are needed; OASIS3-MCT will calculate these weights and corresponding addresses 
+(if they are not already provided) but will not, at run time, calculate the two extra terms to which the 
+second and third weights should be applied; these terms, respectively the gradient of the field with respect 
+to the longitude and the gradient of the field with respect to the latitude,
+need to be calculated by the source code and transfered as extra arguments of the oasis_put. []
+
+Note that CONSERV/SECOND is not positive definite and has not been fully validated yet. []
+
+[section=Precautions related to the use of the SCRIPR/CONSERV remapping]
+- For the 1st order conservative remapping: the weight of a source cell is proportional to area of the 
+source cell intersected by target cell. Using the divergence theorem, the SCRIP library evaluates this  
+area with the line integral along the cell borders enclosing the area. As the real shape of the borders  
+is not known (only the location of the 4 corners of each cell is known), the library assumes that the  
+borders are linear in latitude and longitude between two corners. This assumption becomes less valid 
+closer to the pole and for latitudes above the north_thresh or below the south_thresh values 
+(see oasis3-mct/lib/scrip/src/remap_conserv.F, the library evaluates the intersection between two border 
+segments using a Lambert equivalent azimuthal projection. Problems were observed in some cases for 
+the grid cell located around this north_thresh or south_thresh latitude. []
+- Another limitation of the SCRIP 1st order conservative remapping algorithm is that is also supposes, 
+for line integral calculation, that sin(latitude) is linear in longitude on the cell borders which 
+again is in general not valid close to the pole. []
+- For a proper consevative remapping, the corners of a cell have to coincide with the corners of 
+its neighbour cell, with no ``holes'' between the cells. []
+- If two cells of one same grid overlay, at least the one with the greater numerical index must be 
+masked for a proper conservative remapping. For example, if the grid cells with i=1 overlays the 
+grid cells with i=imax, the latter must be masked. If this is not the case given the mask defined 
+in masks.nc, OASIS3-MCT must be compiled with the CPP key TREAT_OVERLAY which will ensure that these 
+rules are respected. This CPP key was introduced in OASIS3.3. []
+- A target grid cell intersecting no source cell (either masked or non masked) at all i.e. falling 
+in a ``hole'' of the source grid will in all cases get a zero value. []
+- If a target grid cell intersects only masked source cells, it will still get a zero value unless 
+the FRACNNEI normalisation option is used, in which case it will get the nearest non masked neighbour 
+value. Note that the option of having the value 1.0E+20 assigned to these target grid cell intersecting 
+only masked source cells (for easier identification) is not yet availble in OASIS3-MCT.
+</docuold>
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="MAP" order="110" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/mapping.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/mapping.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/mapping/mapping.xml	(revision 4775)
@@ -0,0 +1,89 @@
+<model name="mappingtransfo" title="Mapping" layout="flat">
+     <desc>
+Please enter the mapping options, if any, for the different coupling fields,
+selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+     </desc>
+</model>
+ <model name="transfmap" title="Mapping remapping" layout="flat">
+    <multiple name="map" title="Mapping options" require="field_names_list" custom_label="Fields">
+         <xor name="mapremapping" title="Mapping" default="mapping_off">
+	   <model name="mapping_off" title="NO MAPPING">
+	   </model>
+	   <model name="mapping_on" title="MAPPING">
+	     <param name="filename" title="Remapping file (NetCDF)" type="string"/>
+	     <choice name="maploc" title="Where to do the mapping" type="string" default="src">
+	       <option value="src" title="Source processors (src)"/>
+               <option value="dst" title="Target processors (tgt)"/>
+	     </choice>
+	     <choice name="mapstrategy" title="Mapping strategy" type="string" default="bfb">
+	       <option value="bfb" title="Bit-for-bit reproductibility (bfb)"/>
+               <option value="sum" title="Partial sum (sum)"/>
+               <option value="opt" title="Optimized (opt)"/>
+	     </choice>
+           </model>
+	 </xor>
+       </multiple>
+    <docu> 
+[section=Mapping]
+The MAPPING option is used to specify an input file to be read and used for mapping (ie. regridding or interpolation). 
+This is an alternative method to the SCRIP library for setting the mapping file.
+
+
+Since OASIS3-MCT_2.0, MAPPING can be used for higher order remapping. Up to 5 different sets of weights can be applied 
+to up to 5 different fields transfered as oasis_put arguments. []
+
+Some details on the MAPING opton are available in the User Guide section 4.3 and 5.4.
+
+<docuold>
+[section=Mapping file]
+The mapping file to read is a NetCDF file consistent with the SCRIPR map file format, see the Figure 1 below: []
+
+[image=fig_mapping_file_1.gif;caption=Figure 1: Header of the remapping file] []
+    
+- src_grid_size is a scalar integer indicating the total number of points in the source grid. This is 
+typically a large number. This field is a netCDF dimension. []
+- dst_grid_size is a scalar integer indicating the total number of points in the target grid. This is 
+typically a large number. This field is a netCDF dimension. []
+- num_links is a scalar integer indicating the total number of associated grid point pairs in the file. 
+This is typically a large number. This field is a netCDF dimension. []
+- num_wgts is a scalar integer indicating the number of weights per associated grid point pair 
+(up to 5 are supported). This field is a netCDF dimension. []
+- src_address is a one dimensional array of size num_links. It contains the integer source address 
+associated with each weight. This field is a netCDF variable. []
+- dst_address is a one dimensional array of size num_links. It contains the integer destination address 
+associated with each weight. This field is a netCDF variable. []
+- remap_matrix is a two dimensional array of size (num_links, num_wgts). It contains the real weight value(s) 
+associated with the source and destination address. This field is a netCDF variable. []
+
+    
+[section=Mapping options]
+The remapping can done either on the source or the target processors (Mapping location). 
+With the option "source processors" (src), the mapping will be done in parallel on the source processors before 
+communication to the destination model processes; this is the default. With he option "target processors" (dst), 
+the mapping is done on the destination processes after the source grid data is sent from the source model. []
+
+The remapping strategy can be either "Bit-for-bit reproductibility" (bfb), "Partial sum" (sum), 
+or "Optimized" (opt). []
+In bfb mode, the mapping is done using a strategy that produces bit-for-bit identical results regardless of the 
+grid decompositions without leveraging a partial sum computation; this is the default. With sum, the transform 
+is done using the partial sum approach which generally introduces roundoff level changes in the results on 
+different processor counts. Option opt allows the coupling layer to choose either approach based on an analysis 
+of which strategy is likely to run faster. Usually, partial sums will be used if the source grid has a higher 
+resolution than the target grid as this should reduce the overall communication (e.g. for conservative remapping). []
+
+Note that if the SCRIP library is used to calculate the remapping file, MAPPING can still be used to 
+specify a name for the remapping file generated by SCRIP different from the default and/or to specify a 
+remapping location or a remappin strategy option. 
+</docuold>
+  </docu>
+</model>
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Model" order="12" script="process_models.py"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/model.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/model.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/modeldef/model.xml	(revision 4775)
@@ -0,0 +1,43 @@
+  <model name="mainmodelparam" title="Main model parameters" layout="flat">
+  <desc>
+Please enter the name of each model running in the experiment using the button "add Models", 
+double clicking on the new row created and filling the part "no label" under "Model names". 
+The name must be validated using the button "Enter" of the keyboard. 
+The "load" button is useless for the OASIS3-MCT application.
+The maximum fortran unit is optional, but if it is specified for one model, it 
+must be specified for all the models. []
+The blue (?), located at the right bottom of this window, gives more information on each data to fill up.
+When processing this window, it will be necessary to save the xml file.
+  </desc>
+  </model>
+  <model name="modelparam" title="Model parameters" layout="flat">
+    <multiple name="models" title="Models" custom_label="Model names">
+         <xor name="maxunits" title="Maximum fortran units" default="units_off">
+           <model name="units_off" title="No fortran units">
+           </model>
+           <model name="units_on" title="Max fortran units">
+             <param name="nunit" title="Max Fortran units (integer)" type="integer" />
+           </model>
+         </xor>
+    </multiple>
+    <info name="model_names_list" title="List of the models" type="liststring" visibility="hidden"/>
+    <docu> 
+[section=Model names]
+
+In this part the user must enter the names of the models running in the experiment, 
+which must correspond to the name announced by each model when calling the routine oasis_init_comp
+(see section 2.2.1 of the User Guide).
+
+Then the user may indicate the maximum Fortran unit number used by the models (optional).
+
+More information can be found in the User Guide section 3.2 under the keyword $NBMODEL.
+<docuold>
+In all cases, OASIS3-MCT library assumes, during the
+initialization phase, that units 1025 and 1026 are free and temporarily uses these units to
+read the configuration file and to write corresponding log messages to file nout.000000. After the
+initialization phase, OASIS3-MCT will still suppose that units above 1024 are free, unless maximum
+unit numbers are indicated in the configuration file.
+</docuold>
+    </docu>
+  </model>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Main" order="1" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/image.php
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/image.php	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/image.php	(revision 4775)
@@ -0,0 +1,92 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+
+<html>
+
+<head>
+<meta name="robots" content="noindex,nofollow">
+<meta http-equiv="x-dns-prefetch-control" content="off">
+<script type="text/javascript" language="JavaScript">
+<!--
+if (self != top) { try { if (document.domain != top.document.domain) { throw "Clickjacking security violation! Please log out immediately!"; /* this code should never execute - exception should already have been thrown since it's a security violation in this case to even try to access top.document.domain (but it's left here just to be extra safe) */ } } catch (e) { self.location = "/src/signout.php"; top.location = "/src/signout.php" } }
+// -->
+</script>
+
+<title>SquirrelMail</title><script language="JavaScript" type="text/javascript">
+<!--
+function checkForm() {
+   var f = document.forms.length;
+   var i = 0;
+   var pos = -1;
+   while( pos == -1 && i < f ) {
+       var e = document.forms[i].elements.length;
+       var j = 0;
+       while( pos == -1 && j < e ) {
+           if ( document.forms[i].elements[j].type == 'text'            || document.forms[i].elements[j].type == 'password' ) {
+               pos = j;
+           }
+           j++;
+       }
+   i++;
+   }
+   if( pos >= 0 ) {
+       document.forms[i-1].elements[pos].focus();
+   }
+   
+}
+// -->
+</script>
+
+<!--[if IE 6]>
+<style type="text/css">
+/* avoid stupid IE6 bug with frames and scrollbars */
+body {
+    width: expression(document.documentElement.clientWidth - 30);
+}
+</style>
+<![endif]-->
+
+</head>
+
+<body text="#000000" bgcolor="#ffffff" link="#0000cc" vlink="#0000cc" alink="#0000cc" onload="checkForm();">
+
+<a name="pagetop"></a>
+<table bgcolor="#ffffff" border="0" width="100%" cellspacing="0" cellpadding="2">
+
+<tr bgcolor="#ababab">
+
+<td align="left">
+
+&nbsp;      </td>
+<td align="right">
+<b>
+<a href="/src/signout.php" target="_top">Sign Out</a></b></td>
+   </tr>
+<tr bgcolor="#ffffff">
+
+<td align="left">
+
+<a href="/src/compose.php?mailbox=None&amp;startMessage=0">Compose</a>&nbsp;&nbsp;
+<a href="/src/addressbook.php">Addresses</a>&nbsp;&nbsp;
+<a href="/src/folders.php">Folders</a>&nbsp;&nbsp;
+<a href="/src/options.php">Options</a>&nbsp;&nbsp;
+<a href="/src/search.php?mailbox=None">Search</a>&nbsp;&nbsp;
+<a href="/src/help.php">Help</a>&nbsp;&nbsp;
+      </td>
+<td align="right">
+
+<a href=" https://dino.cerfacs.fr/" target="_blank">CERFACS</a></td>
+   </tr>
+</table><br>
+
+<br /><table width="100%" border="0" cellspacing="0" cellpadding="2" align="center">
+<tr><td bgcolor="#dcdcdc"><b><center>Viewing an image attachment - <a href="read_body.php?mailbox=INBOX&amp;passed_id=53227&amp;startMessage=1&amp;ent_id=0">View message</a></b></td></tr>
+<tr><td align="center">
+<a href="../src/download.php?passed_id=53227&amp;mailbox=INBOX&amp;ent_id=2&amp;absolute_dl=true">Download this as a file</a>
+<br />&nbsp;</td></tr></table>
+
+<table border="0" cellspacing="0" cellpadding="2" align="center">
+<tr><td bgcolor="#ffffff">
+<img src="../src/download.php?passed_id=53227&amp;mailbox=INBOX&amp;ent_id=2&amp;absolute_dl=true" />
+
+</td></tr></table>
+</body></html>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/param_a.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/param_a.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/param/param_a.xml	(revision 4775)
@@ -0,0 +1,104 @@
+<model name="intro" title="OASIS3-MCT coupler" layout="flat">
+    <desc> 
+        [image=header_formation_dec2014.gif]
+        OASIS3-MCT coupler Graphical User Interface
+    </desc>
+    <docu>
+
+
+The OASIS coupler, is a software allowing synchronized exchanges of coupling information between numerical codes 
+representing different components of the climate system. Current OASIS developers are CERFACS (Toulouse, France) 
+and Centre National de la Recherche Scientifique (Paris, France). []
+
+OASIS3-MCT, the new version of the OASIS coupler interfaced with the Model Coupling Toolkit (MCT) from the Argonne National 
+Laboratory, offers today a fully parallel implementation of coupling field regridding and exchange. Low-intrusiveness, portability 
+and flexibility are OASIS3-MCT key design concepts as for all previous OASIS versions. An important difference with respect 
+to previous OASIS3.3 is that there is no separate coupler executable: OASIS3-MCT is a coupling library that 
+needs to be linked to the component models, to interpolate and exchange the coupling 
+fields between these components. []
+
+
+OASIS3-MCT supports coupling of general two-dimensional fields. Unstructured grids and 3D grids are also supported 
+using a one dimension representation of the two or three dimensional structures. Thanks to MCT, all transformations, including 
+regridding, are executed in parallel on the set of source or target component processes and all coupling exchanges are now 
+executed in parallel directly between the components via Message Passing Interface (MPI). OASIS3-MCT also supports file I/O 
+using NetCDF, allowing an easy switch between the coupled and forced modes. In the current version, the implementation of this 
+functionality is however non parallel with the reading/writing of the fields performed only by the master process of the model. []
+
+
+In spite of the significant changes in underlying implementation, usage of OASIS3-MCT in the component code has largely 
+remained unchanged with respect to OASIS3.3. To communicate with another model, or to perform I/O actions, a component 
+model needs to include a few specific calls to the OASIS3-MCT coupling library, using the same API as in OASIS3.3. The 
+configuration file (namcouple) is also largely unchanged relative to OASIS3, although few options are either not used 
+or not supported. []
+
+
+The scalability tests done with OASIS3-MCT at high number of cores and the fact that it supports unstructured grids allow 
+us to conclude that this coupler offers today a fully parallel and efficient coupling solution answering the short and mid 
+term needs of the European climate modelling community. []
+
+
+More information can be found on the OASIS web site: https://oasis.enes.org
+    </docu>
+</model>
+
+<model name="generaldesc" title="Generalities on the GUI" layout="flat">
+    <desc> Generalities on the Graphical User Interface : []
+[section=Generalities] []
+This GUI was developed to create the configuration file (namcouple) of OASIS3-MCT.
+The configuration file contains all user defined information necessary to configure a
+particular coupled run. The first part of the file is devoted to general parameters
+such as the number
+of models involved in the simulation or the level of debugging.
+The second part gathers specific information
+on each coupling (or I/O) field, e.g. their coupling period, the list of transformations
+or interpolations to be performed by OASIS3-MCT.
+All these informations will be defined step by step through this interface to finally be
+written in the configuration file by the GUI (processing the last tab "Config"). []
+   </desc>
+</model>
+
+<model name="guidesc" title="Decription of the GUI" layout="flat">
+    <desc> Short description of the Graphical User Interface : []
+
+[section=Usage]
+All windows defined by the different tabs below the OASIS logo
+must be filled up, from the left to the right. When all data of a window is 
+defined, the window must be validated by clicking on button "Process"
+at the bottom right. If the information provided in the window is correct, the corresponding
+orange (?) bullet becomes green in the tab. An orange (?) bullet in the tab means that 
+no information was stored yet in the window or that the information was not yet validated,
+a red (X) bullet in the tab means that there is an error in the window, 
+and, as already explained, a green (v) bullet in the tab means that
+the data entered in the window is correct.
+If there is a problem in a tab (red (X) bullet), an error message giving more
+information is printed in the bottom window of the GUI.
+Some documentation about the data to be provided by the user in the different windows is available by clicking on the 
+different blue bullets (?) entitled "Learn more".[]
+The first parameters to enter, in the tab "Gen", will be the simulation length, the debugging
+level and the timing information printed by OASIS3-MCT.
+If grouped fields have to be defined (i.e. fields using the same configuration settings sent in a single communication) 
+the "Enable grouped field" must be activated.
+In this case a new tab "Group" will appear to define the different groups.
+Then the model components must be defined in the tab "Model", the grid characteristics of the coupling fields in
+the "Grids" window, and the different names of the coupling fields (before and after transformations), grouped or not,
+in the tab "Fld Name".[] 
+Finally all characteristics and transformations associated to each coupling field (or grouped fields) have to be defined step 
+by step in the following windows. 
+If the first four tabs "Main", "Gen", "Model", âGridsâ and "Fld Names" are not filled up and processed before the others, 
+it will not be possible to enter information about the coupling fields in the following windows.[] 
+A summary of the transformations chosen for the coupling fields will be printed when processing
+the tab "Sum". []
+At some point when filling the GUI or when closing it (File/Quit), the data of the GUI must be saved in an xml file which name
+is chosen by the user. You can reload your xml file using the (File/Load as new) menu at the left top of the GUI 
+(do not use the (File/Load as part) menu). []
+The  final configuration text file will be created and printed in the last window "Config" when processing it, only if
+WHEN ALL THE TABS ARE VALIDATED  (in a directory named after the name of the xml file, see the README file). [] 
+
+[section=Documentation]
+Some documentation is available by clicking on the different blue bullets (?).
+It is also possible to get all the OASIS3-MCT documentation in an html format by using the functionality
+(File/General help) located at the left top of the GUI.
+    </desc>
+</model>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Gen" order="10" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/print.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/print.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/printruns/print.xml	(revision 4775)
@@ -0,0 +1,146 @@
+<model name="descprint" title="Comments on how to fill upt the degub window" layout="flat">
+   <desc>
+Enter the total simulation length, the amount of debug information written by OASIS3-MCT 
+in the "debug" files, whether or not some time statistic information must be printed
+and whether or not there will be some grouped fields in the namcouple.[]
+The blue (?) gives more information on each data to fill up. 
+  </desc>
+</model> 
+
+  <model name="runtime" title="Runtime" layout="flat">
+  <param name="duration" title="Simulation length in sec (integer)" type="integer"/>
+    <docu> 
+[section=Runtime]
+This number is the total simulated time of the run, expressed in seconds (or any other time units as 
+long as the same are used in all models and in the configuration file).
+      </docu>
+  </model>
+
+<model name="debug" title="Debug printing options" layout="flat">
+    <xor name="nlogprt" title="Select the Debugging level" default="none">
+        <model name="none" title="0">   
+        </model>
+        <model name="ptr_1" title="1">
+        </model>
+        <model name="ptr_2" title="2">
+        </model>
+        <model name="ptr_5" title="5">
+        </model>
+        <model name="ptr_10" title="10">
+        </model>
+        <model name="ptr_12" title="12">
+        </model>
+        <model name="ptr_15" title="15">
+        </model>
+        <model name="ptr_20" title="20">
+        </model>
+        <model name="ptr_30" title="30">
+        </model>
+    </xor>
+    <docu>
+
+[section=Debug files]
+The debug level number refers to the amount of debug information written by OASIS3-MCT
+in the "debug" files. In production mode, it should be 0.
+
+In debug mode on massively parallel computer, it should be 1. If it is not enough, it should be
+then 30, the maximum value.  
+
+Detailed information about the meaning of each Debugging level can be found in the User 
+Guide, section 3.2 (see the NLOGPRT keyword).  
+
+<docuold>
+
+The number corresponds to :[]
+0 : one file debug.root.xx is open by the master proces of each model
+and one file debug_notroot.xx is open for all the other processes of
+each model to write only error information. []
+1 : one file debug.root.xx is open by the master proces of each model to
+write information equivalent to level 10 (see below); one file debug.notroot.xx 
+is open for all the other processes of each model to write error information. []
+2 : one file debug.xx.xxxxxx is open by each process of each model to write normal
+production diagnostics. []
+5 : as for 2 with in addition some initial debug info. []
+10: as for 5 with in addition the routine calling tree. []
+12: as for 10 with in addition some routine calling notes. []
+15: as for 12 with even more debug diagnostics. []
+20: as for 15 with in addition some extra runtime analysis. []
+30: full debug information. []
+</docuold>
+  </docu>
+
+ </model>
+ <model name="timestat" title="Time satistics" layout="flat">
+    <xor name="opttime" title="Select the Time statistics option (TIMER_debug variable)" default="none">
+        <model name="none" title="0"> 
+        </model>
+        <model name="opt_1" title="1">
+        </model>
+        <model name="opt_2" title="2">
+        </model>
+        <model name="opt_3" title="3">
+        </model>
+    </xor>
+    <docu>
+
+[section=Timing files]
+This number refers to the amount of time statistic information written by OASIS3-MCT
+in the "timer" files. In production mode, it should be 0.
+
+When time statistic are needed, it should be 1.
+
+Detailed information about the meaning of each TIMER_debug level can be found in the User 
+Guide, section 3.2 (see the NLOGPRT keyword) and section 6.4.2.
+
+<docuold>
+
+The number corresponds to: []
+0 : nothing is calculated, nothing is written. []
+1 : some timings are performed and written in a single file by the process 0
+as well as the min and the max times over all the processes. []
+2 : some timings are performed and each process writes its own file ; process 0
+also writes the min and the max times over all the processes in its file. []
+3 : some timings are peformed and each process writes its own file ; process 0
+also writes in its file the min and the max times over all processes and also writes in
+its file all the results for each process.[]
+
+[section=Timing signification]
+The time given for each timer is calculated by the difference between calls to oasis_timer_start()
+and oasis_timer_stop() and is the accumulated time over the entire run. Here is an overview of the
+meaning of the different timers as implemented by default.[]
+
+[item=total after init:] total time of the simulation, implemented in mod_oasis_method, i.e. between
+the end of oasis_init_comp and the call to mpi_barrier and mpi_finalize in routine oasis_terminate. []
+</docuold>
+    </docu>
+    
+  </model> 
+
+  <model name="generalgroup" title="Group" layout="flat">
+  <param name="groups_onoff" title="Enable grouped fields" type="onoff" default="0" />
+  <info name="mult_fields_name" title="Group fields names" type="liststring" default="single" visibility="hidden"/>
+    <docu>
+[section=Grouping coupling fields]
+OASIS3-MCT supports exchange of multiple fields via a single communication.  
+In the component model codes, these fields are defined as usual, and sent (``put'') or received (``get'') 
+one at a time. 
+
+More details on this new functionality can be found in the User Guide, appendix B.2.4. 
+
+To enable grouped fields, the user must activate the option "Enable grouped fields". 
+In this case a new tab "Group" will appear to define the different groups.
+
+<docuold>
+Inside OASIS3-MCT, the fields are stored and a
+single mapping and send or receive instruction is in fact executed for all fields. 
+This is useful in cases where multiple fields have 
+the same coupling transformations and to reduce communication costs by aggregating
+multiple fields into a single communication. 
+The coupling fields must be sent and received in the same order as they are defined in the corresponding
+single entry of the namcouple.[]
+Note that if a LOCTRAN transformation is needed for these multiple fields, it is necessary to 
+define one restart file per each group of fields. []
+</docuold>
+    </docu>
+  </model>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="LAG" order="60" />
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/seqlag.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/seqlag.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/seqlag/seqlag.xml	(revision 4775)
@@ -0,0 +1,186 @@
+<model name="defineseqlag" title="LAGSEQ" layout="flat">
+    <desc>
+Please enter the LAG and the sequence (SEQ), if any, for 
+the different coupling fields, selecting the different rows available.
+The LAG is useless for INPUT and OUTPUT fields.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+    </desc>
+</model>
+<model name="defseqlag" title="LAG-SEQ" layout="flat">
+    <multiple name="seqlag" title="Definition the LAG and the Sequence" require="field_names_list" custom_label="Fields">
+      <xor name="lag" title="LAG" default="lag_off">
+            <model name="lag_off" title="NO LAG">
+	     <desc> No LAG is defined.
+             </desc>
+            </model>
+            <model name="lag_on" title="LAG">
+	      <param name="lag_fld" title="Lag (integer)" type="double" />
+            </model>
+      </xor>
+      <xor name="seq" title="SEQUENCE" default="seq_off">
+            <model name="seq_off" title="NO SEQ">
+	     <desc> No sequence is defined.
+             </desc>
+            </model>
+            <model name="seq_on" title="SEQ">
+	      <param name="seq_fld" title="Sequence (integer)" type="integer" />
+            </model>
+      </xor>
+    </multiple> 
+    <docu> 
+
+[section=LAG]
+With LAG>0 for coupling fields in the namcouple (LAG must be equal to the time step of the source model), 
+models read their data at t=0 in their restart files 
+and write a restart file at the end of the simulation for the next run. This configuration is the one that is 
+usually used in the real coupled models.
+
+Defining LAG=dt (time step of the model) implies that there will be a shift in time between the oasis_put and the oasis_get. 
+If tCPL is the coupling time, the oasis_put done at tCPL + LAG will match the oasis_get done at tCPL.
+
+More information is available section 2.10.1 in the User Guide.
+
+[section=SEQ]
+The order of coupling operations in the system is determined solely by the order of calls to send (put) and
+receive (get) data in the models in conjunction with the setting of the lag in the namcouple.
+Data that is received (get) is always blocking while data that is sent (put) is non-blocking with respect to the model
+making that call. It is possible to deadlock the system if the relative orders of puts and gets in different
+models are not compatible. The SEQ option can be used to avoid such deadlock.
+
+More information is available section 2.10.2 in the User Guide.
+<docuold>
+[section=Generalities]
+Using the OASIS3-MCT coupling library, the user has full flexibility to reproduce different coupling algorithms. In 
+the components, the sending and receiving routines, respectively oasis_put and oasis_get, can be called at each model timestep, 
+with the appropriate date argument giving the actual time (at the beginning of the timestep), expressed in number of 
+seconds since the start of the run or in any other time units, as long as the same are used in all models and 
+in the configuration file. This date argument is automatically analysed by the coupling library and depending on the coupling 
+period and the lag (LAG) chosen by the user for each coupling field in the configuration file, different 
+coupling algorithms can be reproduced without modifying the component model codes themselves. []
+
+With OASIS3-MCT, the SEQ index is no longer needed in the configuration file to specify the sequencing order of different 
+coupling fields. The sequence (SEQ) index now provides the coupling layer with an ability to detect 
+a deadlock before it happens and exit. []
+
+[section=The LAG concept]
+The lag (LAG) value tells the coupler to modify the time at which that data is sent (put) by the amount of the lag. The lag 
+must be expressed in the time unit used (that must be the same in the models and in the configuration file and can be positive or negative 
+but should never be larger (in absolute magnitude) than the coupling period of any field due to problems with restartability 
+and dead-locking. When a component model calls a oasis_put, the value of the lag is automatically added to the value of the 
+date argument and the ``put'' is actually performed when the sum date+lag is a coupling time; in the target component, this 
+``put'' will match a oasis_get for which the date argument is the same coupling time. The lag only shifts the time data is sent. 
+It cannot be used to shift the time data is received yet. []
+
+When the lag is positive, a restart file must be available to initiate the coupling and in those cases, the restart file is 
+then updated at the end of the run. A positive lag acts like a send occurred before the model started. In fact, for a field 
+with positive lag, the source component model automatically reads the field in the restart file during the coupling initialization 
+phase (below the oasis_enddef) and send the data to match the oasis_get performed at time=0 in the target component model. 
+The final coupling data on the source side will then be automatically written to the restart file for use in the next run. []
+
+When there is a lag, the first and last instance of the source field in the debug netCDF file (EXPOUT fields) always correspond 
+respectively to the field read from and written to the restart file.
+
+On the figures below, short black arrows correspond to oasis_put or oasis_get called in the component model that 
+do not lead to any ``put'' or receiving action; long black arrows correspond to oasis_put or oasis_get called in the component 
+models that do actually lead to a ``put'' or ``get'' action; long red arrows correspond to oasis_put or oasis_get called in 
+the component models that lead to a reading or writing of the coupling field from or to a coupling restart file.
+
+
+[item=LAG concept first example:]
+
+
+A first coupling algorithm, exploiting the LAG concept, is illustrated on figure 1. []
+
+[image=fig_lag_concept_1.gif;caption=Figure 1: LAG concept first example] []
+
+During a coupling timestep, model A receives F_2 and then sends F_1; its timestep length is 4. During a coupling timestep, model B receives F_1 
+and then sends F_2; its timestep length is 6. F_1 and F_2 coupling periods are respectively 12 and 24. If F_1/F_2 ``put" action by model A/B 
+was used at a coupling timestep to match the model B/A ``get" action, a deadlock would occur as both models would be initially 
+waiting on a ``get" action. To prevent this, F_1 and F_2 produced at the timestep before have to be used to match respectively the model 
+B and model A ``get" actions. []
+
+This implies that a lag of respectively 4 and 6 seconds must be defined for F_1 and F_2. For F_1, the oasis_put performed at time 8 
+and 20 by model A will then lead to ``put" actions (as 8 + 4 = 12 and 20 + 4 = 24 which are coupling periods) that match the 
+``get" actions performed at times 12 and 24 below the oasis_get called by model B. For F_2, the oasis_put performed at time 18 
+by model B then leads to a ``put" action (as 18 + 6 = 24 which is a coupling period) that matches the ``get" action performed i
+at time 24 below the oasis_get called by model A. []
+
+At the beginning of the run, as their LAG index is greater than 0, the first oasis_get of F_1 and F_2 will automatically be fulfilled 
+with fields read from their respective coupling restart files. The user therefore has to create those coupling restart files before 
+the first run in the experiment. At the end of the run, F_1 having a lag greater than 0, is automatically written to its coupling 
+restart file below the last F_1 oasis_put as the date+lag equals the total run time. The analogue is true for F_2. These values 
+will automatically be read in at the beginning of the next run below the respective oasis_get. []
+
+
+[item=LAG concept second example:]
+
+A second coupling algorithm exploiting the LAG concept is illustrated on figure 2. During its timestep, model A receives F_2, sends 
+F_3 and then F_1; its timestep length is 6. During its timestep, model B receives F_1, receives F_3 and then sends F_2; its timestep 
+length is also 6. F_1, F_2 and F_3 coupling periods are both supposed to be equal to 12. []
+
+
+[image=fig_lag_concept_2.gif;caption=Figure 2: LAG concept second example] []
+
+
+For F_1 and F_2 the situation is similar to the first example. If F_1/F_2 ``put" action by model A/B was used at a coupling timestep 
+to match the model B/A ``get" action, a deadlock would occur as both models would be waiting on a ``get" action. To prevent this, F_1 and 
+F_2 produced at the timestep before have to be used to match the model A and model B ``get" actions, which means that a lag of 6 must 
+be defined for both F_1 and F_2. For both coupling fields, the oasis_put performed at times 6 and 18 by the source model then 
+lead to ``put" actions (as 6 + 6 = 12 and 18 + 6 = 24 which are coupling periods) that match the ``get" action performed at time 
+12 and 24 below the oasis_get called by the target model. []
+
+For F_3, sent by model A and received by model B, no lag needs to be defined: the coupling field produced by model A at the 
+coupling timestep can be ``consumed'' by model B without causing a deadlock situation. []
+
+As in the first example, the oasis_get performed at the beginning of the run for F_1 and F_2, will automatically receive data 
+read from their coupling restart files, and the last oasis_put performed at the end of the run automatically write them to 
+their coupling restart file. For F_3, no coupling restart file is needed nor used as at each coupling period the coupling 
+field produced by model A can be directly ``consumed'' by model B. []
+
+We see here how the introduction of appropriate LAG indices results in receiving in the target model the coupling fields 
+produced by the source model the timestep before; this is, in some coupling configurations, essential to avoid deadlock situations. [] 
+
+
+[section=The sequence concept]
+The order of coupling operations in the system is determined solely by the order of calls to send (put) and receive (get) 
+data in the models in conjunction with the setting of the lag in the configuration file. Data that is received (get) is always 
+blocking while data that is sent (put) is non-blocking with respect to the model making that call. It is possible to 
+deadlock the system if the relative orders of puts and gets in different models are not compatible. []
+
+With OASIS3-MCT, the sequence (SEQ) index in the configuration file now provides the coupling layer with an ability to detect 
+a deadlock before it happens and exit. It does this by tracking the order of get and put calls in models compared to the SEQ 
+specified in the configuration file. If there are any inconsistencies, the model will abort gracefully with a useable error message 
+before the system deadlocks. If there are any coupling dependencies in the system, use of the SEQ index is recommended for 
+diagnosis but has no impact on the ultimate solution and is NOT required. []
+
+Take the following two examples. In both examples, there are two models, each ``put'' a field to the other at every coupling 
+period without any lags. In the first case, there is no dependency and each model sends (puts) the data first and then 
+receives the data second at each timestep. []
+
+
+[image=fig_seq_1.gif;caption=Figure 3: SEQ concept first example] []
+
+
+The put from model1 for fld1 is received by the get in model2 and the put from model2 for fld2 is received by the get in 
+model1. In this case, there is no sequencing dependency and the value of SEQ must be identical (or unset) in the configuration file 
+description of the fld1 and fld2 coupling. If SEQ is set to 1 for fld1 and 2 for fld2 in this case, then the model will 
+abort because at runtime, the coupling will detect, in model 2, that fld2 was sent before fld1 was received which is out 
+of sequence as defined by the SEQ settings.[]
+
+In the next example, there is a dependency in the sequencing. []
+
+
+[image=fig_seq_2.gif;caption=Figure 4: SEQ concept second example] []
+
+
+In model2, fld2 depends on fld1. If this dependency is known, then there is a benefit in using SEQ=1 for fld1 and SEQ=2 
+for fld2. At runtime, if the sequencings of both model1 and model2 do not match the above diagram, the model will abort 
+gracefully. For instance, if model2 has the dependency shown above but model1 does not have consistent ordering of the 
+put and get as required by model2, then if SEQ is unused, the model will deadlock and hang. If SEQ is set properly, 
+the coupling layer will detect that the required sequence has not been followed and will exit gracefully with an error message. []
+
+Again, the SEQ namecouple setting is only diagnostic and is not required. 
+</docuold>
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/folderParameters.xml	(revision 4775)
@@ -0,0 +1,1 @@
+<tab title="Sum" order="130" script="process_summary.py"/>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/summary.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/summary.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/summary/summary.xml	(revision 4775)
@@ -0,0 +1,7 @@
+<model name="scriptsummary" title="Summary" layout="flat">
+    <comment name="summaryscript" title="Summary of the characteristics of the different coupling fields (click on the Process button)" size="3;5" />
+    <docu>
+[section=Summary of the characteristics of the coupling fields]
+When processing this windows, a summary of all the coupling fields with their transformations will be printed.  
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/folderParameters.xml	(revision 4775)
@@ -0,0 +1,2 @@
+<tab title="Time" order="70"/>
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/timetranso.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/timetranso.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/timetransfo/timetranso.xml	(revision 4775)
@@ -0,0 +1,58 @@
+ <model name="timetransfo" title="Time transfos" layout="flat">
+   <desc>
+Please enter the time tranformations, if any, for the different coupling fields,
+selecting the different rows available.
+The "load" button is useless for the OASIS3-MCT application.[]
+A blue (?), located at the right bottom of this window, gives more information on the data to fill up.
+   </desc>
+</model> 
+ <model name="transftime" title="Time transformations" layout="flat">
+ <multiple name="time" title="Time options" require="field_names_list" custom_label="Fields">
+	 <xor name="loctrans" title="LOCTRANS" layout="flat" default="loctrans_off">
+	   <model name="loctrans_off" title="NO LOCTRANS">
+           </model>
+	   <model name="loctrans_on" title="LOCTRANS">
+	     <choice name="loctransdef" title="Type of time transformation" type="string" default="average">
+               <option value="average" title="AVERAGE"/>
+	       <option value="accumul" title="ACCUMUL"/>
+               <option value="tmin" title="T_MIN"/>
+               <option value="tmax" title="T_MAX"/>
+	     </choice>
+           </model>
+         </xor>
+</multiple>
+    <docu> 
+
+[section=Time transformations definitions]
+
+[item=INSTANT (default, corresponds to NO LOCTRANS option):] No time transformation, the instantaneous field is transferred []
+[item=ACCUMUL:] The field accumulated over the previous coupling period is exchanged (the accumulation 
+is simply done over the arrays field_array provided as third argument to the oasis_put calls, 
+not weighted by the time interval between these calls) []
+[item=AVERAGE:] The field averaged over the previous coupling period is transferred (the average is 
+simply done over the arrays field_array provided as third argument to the oasis_put calls, not 
+weighted by the time interval between these calls)  []
+[item=T_MIN:] The minimum value of the field for each source grid point over the previous 
+coupling period is transferred []
+[item=T_MAX:] The maximum value of the field for each source grid point over the previous 
+coupling period is transferred []
+
+More details can be found in the User Guide section 4.1.
+
+<docuold>
+With OASIS3-MCT, time transformations are supported more generally with use of the coupling restart file.
+The coupling restart file allows the partial time transformation to be saved at the end of a run for exact
+restart at the start of the next run. For that reason, coupling restart filenames are now required for all
+namcouple entries that use LOCTRANS. This is the reason an optional restart file is
+now provided on the OUTPUT namcouple input line. 
+</docuold>
+    </docu>
+</model>
+
+
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/folderParameters.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/folderParameters.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/folderParameters.xml	(revision 4775)
@@ -0,0 +1,1 @@
+<tab title="Config" order="140" script="write_namcouple.py" />
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/write.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/write.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/XML/oasis3-mct/write/write.xml	(revision 4775)
@@ -0,0 +1,8 @@
+<model name="scriptnamcouple" title="Configuration file" layout="flat">
+    <comment name="namcouplescript" title="Namcouple (Click on the Process button)" size="3;5"/>
+    <docu>
+[section=Configuration file Nacmouple]
+When processing the window, the namcouple will appear in the window. It will be also saved at the
+same time where the xml file, containing the data of the coupling configuration, is saved (in RES_C3SM).
+    </docu>
+</model>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_fielddef.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_fielddef.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_fielddef.py	(revision 4775)
@@ -0,0 +1,51 @@
+from XDR import *
+
+###########################
+# INITIALIZATION
+
+init()
+
+##
+# 
+# Create the list (names of fields only used by the GUI) of the fields (single or multiple)
+# that will be used in the definition of transformations
+# for single fields, the label will be the field name entered by the user
+# for multiple fields, the label will be the name of the multiple  
+field_names_list = []
+after_field_names_list = []
+multiple_list = []
+for field in getChildrenName("flddef"):
+    if (getValue("fldmult",field) == "single") :
+        after_field_name = getValue("fldnameaft",field)
+#        field_name=getValue("fldnamebef",field)+"-"+after_field_name
+        field_name=getValue(field)
+        #field_names_list.append(field_name)
+        field_names_list.append(getValue(field))
+        if after_field_name in after_field_names_list:
+            error("Name "+after_field_name+" is already in use")
+        else:
+            after_field_names_list.append(after_field_name)
+        if field_name in after_field_names_list:
+            error("Name "+field_name+" is already in use")
+        else:
+            after_field_names_list.append(field_name)
+    else : 
+        if getValue("fldmult",field) in multiple_list:
+            print ("Name of the multiple alreay define in the list")
+        else :
+            field_name=getValue("fldmult",field)
+            field_names_list.append(field_name)
+            multiple_list.append(field_name)
+    setValue(field_name,"namefldgui",field)
+
+
+print(field_names_list, "field_names_list")
+setValue(field_names_list, "field_names_list")
+
+finish()
+
+
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_grids.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_grids.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_grids.py	(revision 4775)
@@ -0,0 +1,37 @@
+from XDR import *
+
+###########################
+# INITIALIZATION
+
+init()
+
+##
+# 
+grid_names_list = []
+grid_dims_list = []
+
+# Create the list of grid names 
+# Verify that either all the dimensions are given for all grids
+# either none dimensions are given
+nb_grids = 0
+nb_dims = 0
+for grid_id in getChildrenName("gridsline"):
+    grid_name = getValue(grid_id)
+    grid_names_list.append(grid_name)
+    nb_grids += 1
+    if grid_name == "no label":
+        error("You must give a name to your grid or delete it")
+    if (len(grid_name) != 4):
+        error("Grid name must be 4 characters")
+    if getValue("dimsgrid",grid_id) == "dims_on" :
+        nb_dims += 1
+
+if nb_grids != nb_dims and nb_dims != 0:
+    error("The dimensions of the grids must be given for none or for all the grids")
+
+#print(grid_names_list)
+setValue(grid_names_list, "grid_names_list")
+
+finish()
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_groups.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_groups.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_groups.py	(revision 4775)
@@ -0,0 +1,30 @@
+from XDR import *
+
+###########################
+# INITIALIZATION
+
+init()
+
+##
+# 
+mult_fields_name = ["single"]
+after_group_names_list = []
+
+# Create the multiple fields names 
+# in function of the nb_mult value
+
+index = 1
+
+for group_id in getChildrenName("group"):
+    group_name = getValue(group_id)
+    mult_fields_name.append(group_name)
+    if group_name == "no label":
+        error("You must give a name to your group or delete it")
+
+
+#print(mult_fields_name)
+setValue(mult_fields_name, "mult_fields_name")
+
+finish()
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_models.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_models.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_models.py	(revision 4775)
@@ -0,0 +1,36 @@
+from XDR import *
+
+###########################
+# INITIALIZATION
+
+init()
+
+##
+# 
+model_names_list = []
+after_model_names_list = []
+
+# Create the list with the names of the models
+# Verify that either all the maximum fortran are given for all the models
+# either none fortran units are given
+nb_models = 0
+nb_units = 0
+for model_id in getChildrenName("models"):
+    model_name = getValue(model_id)
+    model_names_list.append(model_name)
+    nb_models += 1
+    if model_name == "no label":
+        error("You must give a name to your model or delete it")
+    if getValue("maxunits",model_id) == "units_on" :
+        nb_units += 1
+
+if  nb_models != nb_units and nb_units != 0 :
+    error("The maximum fortan units must be given for none or for all the models")
+
+
+#print model_names_list
+setValue(model_names_list, "model_names_list")
+
+finish()
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_summary.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_summary.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/process_summary.py	(revision 4775)
@@ -0,0 +1,311 @@
+from XDR import *
+
+
+###########################
+# INITIALIZATION
+
+init()
+
+
+gridline="******************************************************************"
+gridline+="\n"
+gridline+="*** Summary of the coupling fields and their transformations: \n"
+gridline+="******************************************************************"
+gridline+="\n"
+gridline+="******************************************************************"
+gridline+="\n"
+multiple_list= []
+mult_fields_name=[]
+mult_array={}
+grid_array={}
+grid_names_list=[]
+
+# Get the possible type of fields (single, multiple1, multiple2 ...)
+# depending on nb_mult (by default list initialized to (single,multiple1))
+mult_fields_name=getListValue("mult_fields_name")
+grid_names_list=getListValue("grid_names_list")
+#print("nb_mult",nb_mult)
+#print("mult_fields_name",mult_fields_name)
+
+# Construction of the real names of the sent fields and the received
+# fields for each multiple and store them in the array mult_array
+for mult in mult_fields_name:
+    if mult != "single" :
+#        print(mult)
+        sendnames = []
+        recvnames = []
+        for fields in getChildrenName("flddef"):
+            if getValue("fldmult",fields) == mult:
+                send =getValue("fldnamebef",fields)     
+                recv =getValue("fldnameaft",fields)     
+                field_label = getValue(fields)
+                for fields2 in getChildrenName("group"):
+                    field_label2 = getValue(fields2,"group")
+                    for fields3 in getChildrenName("crs"):
+                        field_label3 = getValue(fields3,"crs")
+#                        print(field_label3,field_label2) 
+                        if field_label3 == field_label2 :
+                            statusf= getValue("status",fields3).upper()
+# Treat the case where the field is INPUT or OUTPUT :
+# source and target symbolic names must be the same
+                            if ( (statusf == "OUTPUT") or (statusf == "INPUT") ) :
+                                send =getValue("fldnamebef",fields)
+                                recv = getValue("fldnamebef",fields)    
+                sendnames.append(send)
+                recvnames.append(recv)
+                mult_array[mult,"sendnames"] = sendnames
+                mult_array[mult,"recvnames"] = recvnames
+#                print(sendnames)
+#                print(recvnames)
+
+
+# Create a tab with the characteristics of the 
+# different grids defined in Grids and used in Fields 
+for gridid in getChildrenName("gridsline"):
+    grid_name=getValue(gridid)
+    grid_array[grid_name,"grid_name"] = grid_name
+    grid_array[grid_name,"grdstatus"] = getValue("gridstatus",gridid)
+    grid_array[grid_name,"overlap"] = getValue("grid_overlap",gridid)
+    grid_array[grid_name,"grddims"] = getValue("dimsgrid",gridid)
+    if grid_array[grid_name,"grddims"] == "dims_on":
+        grid_array[grid_name,"ni"] = getValue("ni_grid",gridid)
+        grid_array[grid_name,"nj"] = getValue("nj_grid",gridid)
+
+
+# Loop over all the coupling fields to write the transformations
+# associated to each field.
+# treat the multiple fields only once. 
+for fields in getChildrenName("flddef"):
+    mult_cat = getValue("fldmult",fields)
+#    print("mult_cat",mult_cat)
+    if (mult_cat == "single") :
+        field_label = getValue(fields)
+        for fields3 in getChildrenName("crs"):
+             field_label3 = getValue(fields3,"crs")
+#             print(field_label3,field_label) 
+             if field_label3 == field_label :
+                 statusf= getValue("status",fields3).upper()
+# Treat the case where the field is INPUT or OUTPUT :
+# source and target symbolic names must be the same
+                 if ( (statusf == "OUTPUT") or (statusf == "INPUT") ) :
+                     gridline+=getValue("fldnamebef",fields)+"-"+getValue("fldnamebef",fields)+":"
+                 else :
+                     gridline+=getValue("fldnamebef",fields)+"-"+getValue("fldnameaft",fields)+":"
+        gridline+="\n" 
+    else: 
+        if mult_cat in multiple_list:
+            print ("Multiple field alreay treated")
+            field_label="nothing"
+        else :
+            multiple_list.append(mult_cat)
+            field_label=mult_cat
+            gridline+=":".join(mult_array[mult_cat,"sendnames"]) + "-"
+            gridline+=":".join(mult_array[mult_cat,"recvnames"]) 
+            gridline+="\n"
+
+# Get the grids informations   
+    if (field_label != "nothing"):
+         src_name=getValue("srcgrid",fields)
+         tgt_name=getValue("tgtgrid",fields)
+         if grid_array[src_name,"grddims"] == "dims_on":
+             gridline+="Source grid :"
+             gridline+=" "
+             gridline+=src_name
+             gridline+="\n"
+             gridline+="Dimensions :"
+             gridline+=" "
+             gridline+=grid_array[src_name,"ni"]+"x"+grid_array[src_name,"nj"]
+             gridline+="\n"
+             gridline+="Target grid :"
+             gridline+=" "
+             gridline+=tgt_name
+             gridline+="\n"
+             gridline+="Dimensions :"
+             gridline+=" "
+             gridline+=grid_array[tgt_name,"ni"]+"x"+grid_array[tgt_name,"nj"]
+             gridline+="\n"
+         else :
+             gridline+="Source grid :"
+             gridline+=" "
+             gridline+=src_name
+             gridline+="\n"
+             gridline+="Target grid :"
+             gridline+=" "
+             gridline+=tgt_name
+             gridline+="\n"
+
+         for fields2 in getChildrenName("crs"):
+             field_label2 = getValue(fields2,"crs")
+             if field_label == field_label2 :
+                 src_status=grid_array[src_name,"grdstatus"]
+                 src_overlap=grid_array[src_name,"overlap"]
+                 tgt_status=grid_array[tgt_name,"grdstatus"]
+                 tgt_overlap=grid_array[tgt_name,"overlap"]
+                 if src_status == "periodical_grid" : 
+                     gridline+="Source grid periodical with "
+                     gridline+=" "
+                     gridline+=src_overlap+" overlapping points"
+                     gridline+="\n"
+                 elif src_status == "regional_grid" :
+                     gridline+="Source grid regional"
+                     gridline+="\n"
+                 if tgt_status == "periodical_grid" : 
+                     gridline+="Target grid periodical with "
+                     gridline+=" "
+                     gridline+=tgt_overlap+" overlapping points"
+                     gridline+=" "
+                 elif tgt_status == "regional_grid" :
+                     gridline+="Target grid regional"
+                     gridline+=" "
+                 gridline+="\n"
+
+# Get the informations concerning the coupling period, the restart file and the
+# status of the field 
+    for fields2 in getChildrenName("crs"):
+        field_label2 = getValue(fields2,"crs")
+#        print(field_label, field_label2)
+        if field_label == field_label2 :
+            gridline+="Coupling period="+getValue("cpl",fields2)
+            gridline+="\n" 
+            gridline+="Restart file: "+getValue("restart",fields2)
+            gridline+="\n" 
+            gridline+="Field status: "+getValue("status",fields2).upper()
+            gridline+="\n" 
+
+    for fields3 in getChildrenName("seqlag","defseqlag"):
+        field_label3 = getValue(fields3,"seqlag")
+        if field_label == field_label3 : 
+            if getValue("seq",fields3) == "seq_on" :
+                 gridline+=" " 
+                 gridline+="SEQ="+getValue("seq_fld",fields3)
+            if getValue("lag",fields3) == "lag_on" :
+                 gridline+=" " 
+                 gridline+="LAG="+getValue("lag_fld",fields3)
+            gridline+="\n"
+    
+
+# Transformations done on the coupling fields
+    for fields2 in getChildrenName("time"):
+        field_label2 = getValue(fields2,"time")
+        if field_label == field_label2 :
+            if getValue("loctrans",fields2) == "loctrans_on" :
+                gridline+="Time transformation:"+getValue("loctransdef",fields2).upper()
+                gridline+="\n"
+
+    for fields2 in getChildrenName("checkinoutminmax"):
+        field_label2 = getValue(fields2,"checkinoutminmax")
+        if field_label == field_label2 :
+            if getValue("checkin",fields2) == "checkin_on" :
+                gridline+="Min and max of the field sent calculated"
+                gridline+="\n"
+
+    for fields2 in getChildrenName("checkinoutminmax"):
+        field_label2 = getValue(fields2,"checkinoutminmax")
+        if field_label == field_label2 :
+            if getValue("checkout",fields2) == "checkout_on" :
+                gridline+="Min and max of the received field calculated"
+                gridline+="\n"
+
+    for fields2 in getChildrenName("multaddoldnew"):
+        field_label2 = getValue(fields2,"multaddoldnew")
+        if field_label == field_label2 :
+            if getValue("blasold",fields2) == "blasold_on" :
+                gridline+="Multiply by "+getValue("xmult_blso","blasold_on",fields2)+" the field sent"
+                gridline+="\n"
+                if getValue("xadd_blso","blasold_on",fields2) == "0." :
+                    gridline+=" "
+                else:
+                    gridline+="Add "+getValue("xadd_blso","blasold_on",fields2)+" to the field sent"
+                    gridline+="\n"
+
+    for fields2 in getChildrenName("multaddoldnew"):
+        field_label2 = getValue(fields2,"multaddoldnew")
+        if field_label == field_label2 :
+            if getValue("blasnew",fields2) == "blasnew_on" :
+                gridline+="Multiply by "+getValue("xmult_blsn","blasnew_on",fields2)+" the received field"
+                gridline+="\n"
+                if getValue("xadd_blsn","blasnew_on",fields2) == "0." :
+                    gridline+=" "
+                else:
+                    gridline+="Add "+getValue("xadd_blsn","blasnew_on",fields2)+" to the received field"
+                    gridline+="\n"
+
+
+    for fields2 in getChildrenName("map"):
+        field_label2 = getValue(fields2,"map")
+        if field_label == field_label2 :
+            if getValue("mapremapping",fields2) == "mapping_on" :
+                gridline+="MAPPING is used with options: "+getValue("maploc",fields2)+" and "+getValue("mapstrategy",fields2)
+                gridline+="\n"
+
+    for fields2 in getChildrenName("interp"):
+        field_label2 = getValue(fields2,"interp")
+        if field_label == field_label2 :
+            if getValue("scrip",fields2) == "scrip_on" :
+                gridline+="SCRIPR is used: "
+                gridline+="\n"
+                if getValue("scriprinterp",fields2) == "distwgt" :
+                    gridline+="DISTWGT interpolation with "+getValue("nv_dist",fields2)+" neighbours"
+                    gridline+="\n"
+                if getValue("scriprinterp",fields2) == "gauswgt" :
+                    gridline+="GAUSWGT interpolation with "+getValue("nv_gaus",fields2)+" neighbours"
+                    gridline+="\n"
+                if getValue("scriprinterp",fields2) == "bilinear" :
+                    gridline+="BILINEAR interpolation"
+                    gridline+="\n"
+                if getValue("scriprinterp",fields2) == "bicubic" :
+                    gridline+="BICUBIC interpolation"
+                    gridline+="\n"
+                if getValue("scriprinterp",fields2) == "conserv_interp" :
+                    gridline+="CONSERVATIVE interpolation of: "
+                    gridline+="\n"
+                    if getValue("order_conserv",fields2) == "first_conserv" :
+                        gridline+= "FIRST ORDER"
+                        gridline+= "\n"
+                    elif getValue("order_conserv",fields2) == "second_conserv" :
+                        gridline+= "SECOND ORDER"
+                        gridline+= "\n"
+                    if getValue("norm_conserv",fields2) == "fracnnei_conserv" :
+                        gridline+= "using FRACNNEI option"
+                        gridline+= " "
+                    elif getValue("norm_conserv",fields2) == "fracarea_conserv" :
+                        gridline+= "FRACAREA"
+                        gridline+= " "
+                    elif getValue("norm_conserv",fields2) == "destarea_conserv" :
+                        gridline+= "DESTAREA"
+                        gridline+= " "
+
+
+    for fields2 in getChildrenName("conservation"):
+        field_label2 = getValue(fields2,"conservation")
+        if field_label == field_label2 :
+            if getValue("conservopt",fields2) == "conserv_on" :
+                gridline+="Redistribution after interpolation (CONSERV)"
+                gridline+="\n"
+                gridline+= "with conserv option: "+getValue("conservstrategy",fields2).upper()
+                gridline+="\n"
+                if getValue("conservalgo",fields2) == "bfb_conserv_on" :
+                    gridline+="and bit-for-bit reproductibility option"
+                    gridline+="\n"
+                elif getValue("conservalgo",fields2) == "opt_conserv_on" :
+                    gridline+="and optimize option"
+                    gridline+="\n"
+
+    if (field_label == "nothing" ):
+        gridline+=""
+    else:
+        gridline+="********************************************************"
+        gridline+="\n"
+        gridline+="********************************************************"
+        gridline+="\n"
+
+
+summaryline=gridline
+# Write the informations in a window of the interface
+# not at the namcouple format
+setValue(summaryline,"summaryscript")
+
+#########################
+# FINISHING
+finish()
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/write_namcouple.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/write_namcouple.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/library/oasis3-mct/scripts/write_namcouple.py	(revision 4775)
@@ -0,0 +1,654 @@
+from XDR import *
+
+
+###########################
+# INITIALIZATION
+
+init()
+
+nam = WriteAsciiFile("namcouple")
+
+nam.writeLine( """# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################""")
+
+###########################
+# NFIELDS
+fieldsline = ""
+nb_fields = 0
+nam.writeLine( """ $NFIELDS """)
+
+fieldsline += "-to_be_replaced_nfields-"
+for fields in getChildrenName("flddef"):
+    nb_fields += 1
+
+fieldsline = fieldsline.replace("-to_be_replaced_nfields-",str(nb_fields))
+
+nam.writeLine( fieldsline )
+nam.writeLine( """ $END
+############################################""")
+
+
+###########################
+# MODELS
+model_names_list=[]
+nam.writeLine( """ $NBMODEL """)
+model_list = getChildrenName("models")
+model_names_list=getListValue("model_names_list")
+
+modelline = str(len(model_list))
+
+for model in model_names_list:
+    modelline+=" "
+    modelline+=model
+    
+for model in getChildrenName("models"):
+    if getValue("maxunits",model) == "units_on" :
+         modelline+=" "
+         modelline+=getValue("nunit",model)
+
+nam.writeLine( modelline )
+nam.writeLine( """ $END
+############################################""")
+
+
+###########################
+# RUNTIME
+nam.writeLine( """ $RUNTIME """)
+nam.writeLine( getValue("duration","runtime") )
+nam.writeLine( """ $END
+############################################""")
+
+###########################
+# DEBUG
+nam.writeLine( """ $NLOGPRT """)
+
+debugline = ""
+
+# Model : debugging options and time statistics
+if getValue("nlogprt") == "none" :
+    debugline+="0"
+if getValue("nlogprt") == "ptr_1" :
+    debugline+="1"
+if getValue("nlogprt") == "ptr_2" :
+    debugline+="2"
+if getValue("nlogprt") == "ptr_5" :
+    debugline+="5"
+if getValue("nlogprt") == "ptr_10" :
+    debugline+="10"
+if getValue("nlogprt") == "ptr_12" :
+    debugline+="12"
+if getValue("nlogprt") == "ptr_15" :
+    debugline+="15"
+if getValue("nlogprt") == "ptr_20" :
+    debugline+="20"
+if getValue("nlogprt") == "ptr_30" :
+    debugline+="30"
+
+
+debugline+=" "
+
+if getValue("opttime") == "none" :
+    debugline+="0"
+if getValue("opttime") == "opt_1" :
+    debugline+="1"
+if getValue("opttime") == "opt_2" :
+    debugline+="2"
+if getValue("opttime") == "opt_3" :
+    debugline+="3"
+
+nam.writeLine(debugline)
+nam.writeLine( """ $END
+############################################""")
+
+
+###########################
+# STRINGS
+nam.writeLine( """ $STRINGS """)
+
+# Everything will be stored in the variable gridline
+# the variable will be write a the end
+
+multiple_list= []
+mult_fields_name=[]
+mult_array={}
+grid_array={}
+grid_names_list=[]
+gridline=""
+new_field_names_list=[]
+before_field_name=""
+after_field_name=""
+
+# Get the list of multiple fields
+# Variable mult_fields_name is defined in the 
+# script process_multiple.py : contains the 
+# values single or multiple 
+mult_fields_name=getListValue("mult_fields_name")
+grid_names_list=getListValue("grid_names_list")
+
+for mult in mult_fields_name:
+    if mult != "single" :
+        sendnames = []
+        recvnames = []
+        for fields in getChildrenName("flddef"):
+            if getValue("fldmult",fields) == mult:
+                send =getValue("fldnamebef",fields)   
+                recv =getValue("fldnameaft",fields)
+                field_label = getValue(fields)
+                for fields2 in getChildrenName("crs"):
+                   field_label2 = getValue(fields2,"crs")
+#                   print(field_label2) 
+                   if field_label2 == field_label :
+                       statusf= getValue("status",fields2).upper()
+# Treat the case where the field is INPUT or OUTPUT :
+# source and target symbolic names must be the same
+                       if ( (statusf == "OUTPUT") or (statusf == "INPUT") ) :
+                           send = getValue("fldnamebef",fields)
+                           recv = getValue("fldnamebef",fields)    
+                sendnames.append(send)
+                recvnames.append(recv)
+                mult_array[mult,"sendnames"] = sendnames
+                mult_array[mult,"recvnames"] = recvnames
+#                print(sendnames)
+#                print(recvnames)
+
+# Create a dictionnary with the characteristics of the 
+# different grids defined in Grids and used in Fields 
+for gridid in getChildrenName("gridsline"):
+    grid_name=getValue(gridid)
+    grid_array[grid_name,"grid_name"] = grid_name 
+    grid_array[grid_name,"grdstatus"] = getValue("gridstatus",gridid)
+    grid_array[grid_name,"overlap"] = getValue("grid_overlap",gridid)
+    grid_array[grid_name,"grddims"] = getValue("dimsgrid",gridid)
+    if grid_array[grid_name,"grddims"] == "dims_on":
+        grid_array[grid_name,"ni"] = getValue("ni_grid",gridid)
+        grid_array[grid_name,"nj"] = getValue("nj_grid",gridid)
+
+# Begin to store the data in gridline :
+# Get the field names to write the first line of STRING
+for fields in getChildrenName("flddef"):
+    mult_cat = getValue("fldmult",fields)
+#    print("mult_cat",mult_cat)
+    if (mult_cat == "single") :
+        field_label = getValue(fields)
+        for fields2 in getChildrenName("crs"):
+            field_label2 = getValue(fields2,"crs")
+            if field_label == field_label2 :
+                statusf= getValue("status",fields2).upper()
+                if ( (statusf == "OUTPUT") or (statusf == "INPUT") ) :
+                    gridline+=getValue("fldnamebef",fields)
+                    gridline+=" "
+                    gridline+=getValue("fldnamebef",fields)
+                    gridline+=" " 
+                    gridline+="1"
+                    gridline+=" "
+                else :
+                    gridline+=getValue("fldnamebef",fields)
+                    gridline+=" "
+                    gridline+=getValue("fldnameaft",fields)
+                    gridline+=" " 
+                    gridline+="1"
+                    gridline+=" "
+    else: 
+        if mult_cat in multiple_list:
+            print ("Multiple field alreay treated")
+            field_label="nothing"
+        else :
+            multiple_list.append(mult_cat)
+            field_label=mult_cat
+            gridline+=":".join(mult_array[mult_cat,"sendnames"]) 
+            gridline+=" "
+            gridline+=":".join(mult_array[mult_cat,"recvnames"])
+            gridline+=" "
+            gridline+="1"
+            gridline+=" "
+
+    nb_transfo = 0
+
+# Get the coupling period, the restart file and the status
+# to write the first line of STRING
+    for fields2 in getChildrenName("crs"):
+        field_label2 = getValue(fields2,"crs")
+        if field_label == field_label2 :
+            gridline += getValue("cpl",fields2)
+            gridline+=" " 
+            gridline += "-to_be_replaced_ntransfo-"
+            gridline+=" " 
+            gridline += getValue("restart",fields2)
+            gridline+=" " 
+            gridline += getValue("status",fields2).upper()
+            gridline+="\n" 
+    
+# Get the grids informations to write the second line of STRING    
+# If the field is INPUT or OUTPUT no dimensions must be written 
+    if (field_label != "nothing"):
+         src_name=getValue("srcgrid",fields)
+         tgt_name=getValue("tgtgrid",fields)
+         for fields2 in getChildrenName("crs"):
+             field_label2 = getValue(fields2,"crs")
+             if field_label == field_label2 :
+                  if (getValue("status",fields2) == "input"):
+                      gridline+=""
+                  if (getValue("status",fields2) == "output"):
+                       gridline+=src_name
+                       gridline+=" "
+                       gridline+=src_name
+                  if ((getValue("status",fields2) == "exported" or getValue("status",fields2) == "expout")):
+                      if (grid_array[src_name,"grddims"] == "dims_on"):
+                           gridline+=grid_array[src_name,"ni"]
+                           gridline+=" "
+                           gridline+=grid_array[src_name,"nj"]
+                           gridline+=" "
+                           gridline+=grid_array[tgt_name,"ni"]
+                           gridline+=" "
+                           gridline+=grid_array[tgt_name,"nj"]
+                           gridline+=" "
+                           gridline+=src_name
+                           gridline+=" "
+                           gridline+=tgt_name
+                      else :
+                           gridline+=src_name
+                           gridline+=" "
+                           gridline+=tgt_name
+
+# Get the SEG and LAG values for the second line of STRING
+    if (field_label != "nothing"):
+         for fields2 in getChildrenName("crs"):
+             field_label2 = getValue(fields2,"crs")
+             if field_label == field_label2 :
+                  if (getValue("status",fields2) == "exported" or getValue("status",fields2) == "expout"):
+                      for fields3 in getChildrenName("seqlag","defseqlag"):
+                          field_label3 = getValue(fields3,"seqlag")
+                          if field_label == field_label3 : 
+                              if getValue("seq",fields3) == "seq_on" :
+                                   gridline+=" " 
+                                   gridline+="SEQ="+getValue("seq_fld",fields3)
+                              if getValue("lag",fields3) == "lag_on" :
+                                   gridline+=" " 
+                                   gridline+="LAG="+getValue("lag_fld",fields3)
+                              gridline+="\n"
+                  if (getValue("status",fields2) == "input"):
+                      gridline+=""
+                  if (getValue("status",fields2) == "output") :
+                      gridline+="\n"        
+
+# Write the third line of STRING : P or R and overlapping points
+    if (field_label != "nothing"):
+         for fields2 in getChildrenName("crs"):
+             field_label2 = getValue(fields2,"crs")
+             if field_label == field_label2 :
+                  if (getValue("status",fields2) == "exported" or getValue("status",fields2) == "expout"):
+                      src_status=grid_array[src_name,"grdstatus"]
+                      src_overlap=grid_array[src_name,"overlap"]
+                      tgt_status=grid_array[tgt_name,"grdstatus"]
+                      tgt_overlap=grid_array[tgt_name,"overlap"]
+                      if src_status == "periodical_grid" : 
+                          gridline+="P"
+                          gridline+=" "
+                          gridline+=src_overlap
+                          gridline+=" "
+                      elif src_status == "regional_grid" :
+                          gridline+="R"
+                          gridline+=" "
+                          gridline+=src_overlap
+                          gridline+=" "
+                      if tgt_status == "periodical_grid" : 
+                          gridline+="P"
+                          gridline+=" "
+                          gridline+=tgt_overlap
+                          gridline+=" "
+                      elif tgt_status == "regional_grid" :
+                          gridline+="R"
+                          gridline+=" "
+                          gridline+=tgt_overlap
+                          gridline+=" "
+                      gridline+="\n"
+
+# Transformations : write the fourth line of STRING with all the
+# transformations that will be applied to the coupling field
+# If the field id INPUT or OUTPUT only LOCTRANS or no transfo are possible
+    if (field_label != "nothing"):
+         for fields100 in getChildrenName("crs"):
+             field_label100 = getValue(fields100,"crs")
+             if field_label == field_label100 :
+                  if (getValue("status",fields100) == "exported" or getValue("status",fields100) == "expout"):
+                      for fields2 in getChildrenName("time"):
+                          field_label2 = getValue(fields2,"time")
+                          if field_label == field_label2 :
+                              if getValue("loctrans",fields2) == "loctrans_on" :
+                                  nb_transfo += 1
+                                  gridline+="LOCTRANS"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("checkinoutminmax"):
+                          field_label2 = getValue(fields2,"checkinoutminmax")
+                          if field_label == field_label2 :
+                              if getValue("checkin",fields2) == "checkin_on" :
+                                  nb_transfo += 1
+                                  gridline+="CHECKIN"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("multaddoldnew"):
+                          field_label2 = getValue(fields2,"multaddoldnew")
+                          if field_label == field_label2 :
+                              if getValue("blasold",fields2) == "blasold_on" :
+                                  nb_transfo += 1
+                                  gridline+="BLASOLD"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("interp"):
+                          field_label2 = getValue(fields2,"interp")
+                          if field_label == field_label2 :
+                              if getValue("scrip",fields2) == "scrip_on" :
+                                  nb_transfo += 1
+                                  gridline+="SCRIPR"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("map"):
+                          field_label2 = getValue(fields2,"map")
+                          if field_label == field_label2 :
+                              if getValue("mapremapping",fields2) == "mapping_on" :
+                                  nb_transfo += 1
+                                  gridline+="MAPPING"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("conservation"):
+                          field_label2 = getValue(fields2,"conservation")
+                          if field_label == field_label2 :
+                              if getValue("conservopt",fields2) == "conserv_on" :
+                                  nb_transfo += 1
+                                  gridline+="CONSERV"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("multaddoldnew"):
+                          field_label2 = getValue(fields2,"multaddoldnew")
+                          if field_label == field_label2 :
+                              if getValue("blasnew",fields2) == "blasnew_on" :
+                                  nb_transfo += 1
+                                  gridline+="BLASNEW"
+                                  gridline+=" "
+                      for fields2 in getChildrenName("checkinoutminmax"):
+                          field_label2 = getValue(fields2,"checkinoutminmax")
+                          if field_label == field_label2 :
+                              if getValue("checkout",fields2) == "checkout_on" :
+                                  nb_transfo += 1
+                                  gridline+="CHECKOUT"
+                                  gridline+=" "
+                              gridline+="\n"
+
+                      if (nb_transfo == 0 and field_label != "nothing"):
+                          error("Number of transformations cannot be 0")
+
+                  else : 
+                      print("Only LOCTRANS transformation is possible for INPUT and OUTPUT coupling fields") 
+                      for fields2 in getChildrenName("time"):
+                          field_label2 = getValue(fields2,"time")
+                          if field_label == field_label2 :
+                              if getValue("loctrans",fields2) == "loctrans_on" :
+                                  nb_transfo += 1
+                                  gridline+="LOCTRANS"
+                                  gridline+="\n"
+ 
+    gridline = gridline.replace("-to_be_replaced_ntransfo-",str(nb_transfo))
+#
+# Write characteristics of the different transformations  
+# on the last lines of STRING for each field 
+
+    if (field_label != "nothing"):
+         for fields100 in getChildrenName("crs"):
+             field_label100 = getValue(fields100,"crs")
+             if field_label == field_label100 :
+                  if (getValue("status",fields100) == "exported" or getValue("status",fields100) == "expout"):
+# LOCTRANS          
+                      for fields2 in getChildrenName("time"):
+                          field_label2 = getValue(fields2,"time")
+                          if field_label == field_label2 :
+                              if getValue("loctrans",fields2) == "loctrans_on" :
+                                  myvalue=""
+                                  myvalue+= getValue("loctransdef",fields2)
+                                  gridline+= myvalue.upper()
+                                  gridline+=" "
+                                  gridline+="\n"
+# CHECKIN
+                      for fields2 in getChildrenName("checkinoutminmax"):
+                          field_label2 = getValue(fields2,"checkinoutminmax")
+                          if field_label == field_label2 :
+                              if getValue("checkin",fields2) == "checkin_on" :
+                                  gridline+="INT=1"
+                                  gridline+="\n"
+# BLASOLD
+                      for fields2 in getChildrenName("multaddoldnew"):
+                          field_label2 = getValue(fields2,"multaddoldnew")
+                          if field_label == field_label2 :
+                              if getValue("blasold",fields2) == "blasold_on" :
+                                  gridline+= getValue("xmult_blso","blasold_on",fields2)
+                                  gridline+=" "
+                                  if getValue("xadd_blso","blasold_on",fields2) == "0." :
+                                      gridline+="0"
+                                      gridline+="\n"
+                                  else:
+                                      gridline+="1"
+                                      gridline+="\n"
+                                      gridline+= "CONSTANT"+" "+getValue("xadd_blso","blasold_on",fields2)
+                                      gridline+=" "
+                                      gridline+="\n"
+
+# SCRIPR 
+                      for fields2 in getChildrenName("interp"):
+                          field_label2 = getValue(fields2,"interp")
+                          if field_label == field_label2 :
+                              if getValue("scrip",fields2) == "scrip_on" :
+                                  if getValue("scriprinterp",fields2) == "distwgt" :
+                                      gridline+="DISTWGT"
+                                      gridline+=" "
+                                      if getValue("cgrs_dist",fields2) == "lr_dist":
+                                          gridline+="LR"
+                                          gridline+=" "
+                                      elif getValue("cgrs_dist",fields2) == "d_dist":
+                                          gridline+="D"
+                                          gridline+=" "
+                                      elif getValue("cgrs_dist",fields2) == "u_dist":
+                                          gridline+="U"
+                                          gridline+=" "
+                                      gridline+="SCALAR"
+                                      gridline+=" "
+                                      if  getValue("rest_dist",fields2) == "latlon_dist":
+                                           gridline+= "LATLON"
+                                           gridline+= " "
+                                      elif getValue("rest_dist",fields2) == "latitude_dist":
+                                           gridline+= "LATITUDE"
+                                           gridline+= " "
+                                      gridline+= getValue("nbin_dist",fields2)
+                                      gridline+=" "
+                                      gridline+= getValue("nv_dist",fields2)
+                                      gridline+= "\n"
+                                  if getValue("scriprinterp",fields2) == "gauswgt" :
+                                      gridline+="GAUSWGT"
+                                      gridline+=" "
+                                      if getValue("cgrs_gaus",fields2) == "lr_gaus":
+                                          gridline+="LR"
+                                          gridline+=" "
+                                      elif getValue("cgrs_gaus",fields2) == "d_gaus":
+                                          gridline+="D"
+                                          gridline+=" "
+                                      elif getValue("cgrs_gaus",fields2) == "u_gaus":
+                                          gridline+="U"
+                                          gridline+=" "
+                                      gridline+="SCALAR"
+                                      gridline+=" "
+                                      if  getValue("rest_gaus",fields2) == "latlon_gaus":
+                                           gridline+= "LATLON"
+                                           gridline+= " "
+                                      elif getValue("rest_gaus",fields2) == "latitude_gaus":
+                                           gridline+= "LATITUDE"
+                                           gridline+= " "
+                                      gridline+= getValue("nbin_gaus",fields2)
+                                      gridline+=" "
+                                      gridline+= getValue("nv_gaus",fields2)
+                                      gridline+=" "
+                                      gridline+= getValue("var_gaus",fields2)
+                                      gridline+= "\n"
+                                  if getValue("scriprinterp",fields2) == "bilinear" :
+                                      gridline+="BILINEAR"
+                                      gridline+=" "
+                                      if getValue("cgrs_bili",fields2) == "lr_bili":
+                                          gridline+="LR"
+                                          gridline+=" "
+                                      elif getValue("cgrs_bili",fields2) == "d_bili":
+                                          gridline+="D"
+                                          gridline+=" "
+                                      gridline+="SCALAR"
+                                      gridline+=" "
+                                      if  getValue("rest_bili",fields2) == "latlon_bili":
+                                           gridline+= "LATLON"
+                                           gridline+= " "
+                                      elif getValue("rest_bili",fields2) == "latitude_bili":
+                                           gridline+= "LATITUDE"
+                                           gridline+= " "
+                                      gridline+= getValue("nbin_bili",fields2)
+                                      gridline+="\n"
+                                  if getValue("scriprinterp",fields2) == "bicubic" :
+                                      gridline+="BICUBIC"
+                                      gridline+=" "
+                                      if getValue("cgrs_bicu",fields2) == "lr_bicu":
+                                          gridline+="LR"
+                                          gridline+=" "
+                                      elif getValue("cgrs_bicu",fields2) == "d_bicu":
+                                          gridline+="D"
+                                          gridline+=" "
+                                      gridline+="SCALAR"
+                                      gridline+=" "
+                                      if  getValue("rest_bicu",fields2) == "latlon_bicu":
+                                           gridline+= "LATLON"
+                                           gridline+= " "
+                                      elif getValue("rest_bicu",fields2) == "latitude_bicu":
+                                           gridline+= "LATITUDE"
+                                           gridline+= " "
+                                      gridline+= getValue("nbin_bicu",fields2)
+                                      gridline+="\n"
+                                  if getValue("scriprinterp",fields2) == "conserv_interp" :
+                                      gridline+="CONSERV"
+                                      gridline+=" "
+                                      if getValue("cgrs_conserv",fields2) == "lr_conserv":
+                                          gridline+="LR"
+                                          gridline+=" "
+                                      elif getValue("cgrs_conserv",fields2) == "d_conserv":
+                                          gridline+="D"
+                                          gridline+=" "
+                                      elif getValue("cgrs_conserv",fields2) == "u_conserv":
+                                          gridline+="U"
+                                          gridline+=" "
+                                      gridline+="SCALAR"
+                                      gridline+=" "
+                                      if  getValue("rest_conserv",fields2) == "latlon_conserv":
+                                           gridline+= "LATLON"
+                                           gridline+= " "
+                                      elif getValue("rest_conserv",fields2) == "latitude_conserv":
+                                           gridline+= "LATITUDE"
+                                           gridline+= " "
+                                      gridline+= getValue("nbin_conserv",fields2)
+                                      gridline+=" "
+                                      if getValue("norm_conserv",fields2) == "fracnnei_conserv" :
+                                          gridline+= "FRACNNEI"
+                                          gridline+= " "
+                                      elif getValue("norm_conserv",fields2) == "fracarea_conserv" :
+                                          gridline+= "FRACAREA"
+                                          gridline+= " "
+                                      elif getValue("norm_conserv",fields2) == "destarea_conserv" :
+                                          gridline+= "DESTAREA"
+                                          gridline+= " "
+                                      if getValue("order_conserv",fields2) == "first_conserv" :
+                                          gridline+= "FIRST"
+                                          gridline+= "\n"
+                                      elif getValue("order_conserv",fields2) == "second_conserv" :
+                                          gridline+= "SECOND"
+                                          gridline+= "\n"
+
+# MAPPING
+                      for fields2 in getChildrenName("map"):
+                          field_label2 = getValue(fields2,"map")
+                          if field_label == field_label2 :
+                              if getValue("mapremapping",fields2) == "mapping_on" :
+                                  gridline+= getValue("filename",fields2)
+                                  gridline+=" "
+                                  gridline+= getValue("maploc",fields2)
+                                  gridline+=" "
+                                  gridline+= getValue("mapstrategy",fields2)
+                                  gridline+=" "
+                                  gridline+="\n"
+
+# CONSERV
+                      for fields2 in getChildrenName("conservation"):
+                          field_label2 = getValue(fields2,"conservation")
+                          if field_label == field_label2 :
+                              if getValue("conservopt",fields2) == "conserv_on" :
+                                  gridline+= getValue("conservstrategy",fields2).upper()
+                                  gridline+=" "
+                                  if getValue("conservalgo",fields2) == "bfb_conserv_on" :
+                                      gridline+="bfb"
+                                      gridline+=" "
+                                      gridline+="\n"
+                                  elif getValue("conservalgo",fields2) == "opt_conserv_on" :
+                                      gridline+="opt"
+                                      gridline+=" "
+                                      gridline+="\n"
+
+# BLASNEW
+                      for fields2 in getChildrenName("multaddoldnew"):
+                          field_label2 = getValue(fields2,"multaddoldnew")
+                          if field_label == field_label2 :
+                              if getValue("blasnew",fields2) == "blasnew_on" :
+                                  gridline+= getValue("xmult_blsn","blasnew_on",fields2)
+                                  gridline+=" "
+                                  if getValue("xadd_blsn","blasnew_on",fields2) == "0." :
+                                      gridline+="0"
+                                      gridline+="\n"
+                                  else:
+                                      gridline+="1"
+                                      gridline+="\n"
+                                      gridline+= "CONSTANT"+" "+getValue("xadd_blsn","blasnew_on",fields2)
+                                      gridline+=" "
+                                      gridline+="\n"
+# CHECKOUT
+                      for fields2 in getChildrenName("checkinoutminmax"):
+                          field_label2 = getValue(fields2,"checkinoutminmax")
+                          if field_label == field_label2 :
+                              if getValue("checkout",fields2) == "checkout_on" :
+                                  gridline+="INT=1"
+                                  gridline+="\n"
+#### HERE ELSE FOR INPUT and OUTPUT
+                  else :    
+# LOCTRANS          
+                      for fields2 in getChildrenName("time"):
+                          field_label2 = getValue(fields2,"time")
+                          if field_label == field_label2 :
+                              if getValue("loctrans",fields2) == "loctrans_on" :
+                                  myvalue=""
+                                  myvalue+= getValue("loctransdef",fields2)
+                                  gridline+= myvalue.upper()
+                                  gridline+=" "
+                                  gridline+="\n"
+
+    if (field_label == "nothing" ):
+        gridline+=""
+    else:
+        gridline+="####"
+        gridline+="\n"
+
+gridline += " $END"
+nam.writeLine(gridline)
+nam.writeLine("############################################")
+
+nam.close()
+
+# Write the namcouple in a window of the interface
+totaltime=getValue("duration","runtime")
+gridline2=gridline
+namcoupleline="$NFIELDS \n"+fieldsline+"\n"+"$END \n"+"####"+"\n"+"$NBMODEL \n"+modelline+"\n"+"$END \n"+"####"+"\n"+"$RUNTIME \n"+totaltime+"\n"+"$END \n"+"####"+"\n"+"$NLOGPRT \n"+debugline+"\n"+"$END \n"+"####"+"\n"+"$STRINGS \n"+gridline2
+setValue(namcoupleline,"namcouplescript")
+
+#########################
+# FINISHING
+finish()
+
+
+
+
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/myconfig.xml
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/myconfig.xml	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/myconfig.xml	(revision 4775)
@@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="utf-8"?>
+<dataset>         
+          <config value="">    
+                <gui value="">      
+                      <appearance value="">        
+                            <width value="1300"/>        
+                            <height value="800"/>        
+                            <theme value="clam"/>        
+                            <mode value="multicolumn"/>        
+                            <focusCorrection value="0"/>        
+                      </appearance>      
+                      <paths value="">        
+                            <workingDir value="."/>        
+                      </paths>      
+                      <python value="">        
+                            <interpreter value=""/>        
+                      </python>      
+                </gui>    
+                <id value="">      
+                      <user value="">        
+                            <name value="myName"/>        
+                            <company value="myCompany"/>        
+                            <expert value="0"/>        
+                      </user>      
+                </id>    
+                <accounts value="">      
+                      <code_plugins value="local_unix">        
+                            <local_unix value="">          
+                                  <nbprocs value="1"/>          
+                            </local_unix>        
+                      </code_plugins>      
+                      <tool_plugins value="local_unix">        
+                            <local_unix value="">          
+                                  <nbprocs value="1"/>          
+                            </local_unix>        
+                      </tool_plugins>      
+                </accounts>    
+          </config>  
+      <meta/></dataset>
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/XMLparser.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/XMLparser.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/XMLparser.tcl	(revision 4775)
@@ -0,0 +1,522 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc XMLnewNode {command attributes icurrentNodes itree} {
+    upvar $icurrentNodes currentNodes
+    upvar $itree tree
+   if {[llength $attributes] == 0} { # No attributes, name is then the command name
+        set name $command
+   } elseif {[llength $attributes] == 2} { # If only one attribute, name is the value whatever it is
+        set name [lindex $attributes 1]
+   } else { # Searches for node name in the attributes and node value for option command
+        set name [lindex $attributes [expr [lsearch -nocase $attributes name]+1]]
+   }
+    
+    if {$command == "include"} {set name "[join $name "_"]_include" }
+    if {$command == "option"} {set name [lindex $attributes [expr [lsearch -nocase $attributes value]+1]]} 
+    if {$name == ""} {error 0 "No name in the node #$currentNodes $command# with attributes : $attributes"}
+    
+    # Build the key of the node
+    set key "root"
+    foreach item $currentNodes {
+        lappend key [lindex $item 1]
+    }
+    
+    # Check uniqueness of the name
+    if {[dTree_nodeExists $tree "$key $name"]} {error 0 "The node $key $name already exists"}
+    dTree_addNode tree $key $name 
+    
+    # Updates the path in tree
+    lappend currentNodes [list $command $name]
+    lappend key $name
+    
+    #Adds the attributes
+    dTree_setAttribute tree $key "nodeType" $command
+    foreach {attr value} $attributes {
+        dTree_setAttribute tree $key $attr $value
+    }
+}
+
+proc modelNewNode {command attributes icurrentNodes itree} {
+    upvar $icurrentNodes currentNodes
+    upvar $itree tree
+    set name $command
+    
+    if {$name == ""} {error 0 "No name in the node #$currentNodes $command# with attributes : $attributes"}
+    
+    # Build the key of the node
+    set key "root"
+    foreach item $currentNodes {
+        lappend key [lindex $item 1]
+    }
+    
+    # Check uniqueness of the name
+    if {[dTree_nodeExists $tree "$key $name"]} {error 0 "The node $key $name already exists"}
+        
+    dTree_addNode tree $key $name
+    # Updates the path in tree
+    lappend currentNodes [list $command $name]
+    lappend key $name
+    
+    #Adds the attributes
+    
+    foreach {attr value} $attributes {
+        dTree_setAttribute tree $key $attr $value
+    }
+}
+
+proc XMLendNode {command icurrentNodes itree} {
+    upvar $icurrentNodes currentNodes
+    upvar $itree tree
+    
+    # Controls that the end tag is correct
+    set currentNode [lindex $currentNodes end 0]
+    if {$currentNode != $command} {
+        error 0 "end tag unexpected : expected $currentNode but detected $command, current nodes : $currentNodes"
+    }
+    set currentNodes [lrange $currentNodes 0 end-1]
+}
+
+proc modelEndNode {command icurrentNodes itree} {
+    upvar $icurrentNodes currentNodes
+    upvar $itree tree
+    
+    # Controls that the end tag is correct
+    set currentNode [lindex $currentNodes end 0]
+    if {$currentNode != $command} {
+        error 0 "end tag unexpected : expected $currentNode but detected $command, current nodes : $currentNodes"
+    }
+    set currentNodes [lrange $currentNodes 0 end-1]
+}
+
+proc XMLaddContent {line icurrentNodes itree} {
+    upvar $icurrentNodes currentNodes
+    upvar $itree tree
+    set line [string trim $line]
+    if { $line == ""} {return 0}
+
+    # Build the key of the node
+    set key "root"
+    foreach item $currentNodes {
+        lappend key [lindex $item 1]
+    }
+    #lappend key
+    
+
+    # If no existing content, creates the XMLContent node
+    if {![dict exists $tree $key "XMLContent"]} {
+        dTree_setAttribute tree $key "XMLContent" "$line"
+    } else {
+        dTree_setAttribute tree $key "XMLContent" "[dTree_getAttribute tree $key XMLContent] $line"
+    }
+    
+    
+}
+
+proc analyseTag {contentTag itree icurrentNodes fileType} {
+    
+    upvar $itree tree
+    upvar $icurrentNodes currentNodes
+    
+    set tagType "begin"
+    
+    #Clean content
+    set contentTag [string trim $contentTag]
+    if {$contentTag == ""} {
+        error "Error : one tag seems to be empty"
+    }
+    # Extract tag name and test if slash is present to detect type of tag
+    set tagName [lindex [split $contentTag " "] 0]
+    if {$tagName!=[string trimleft $tagName "/"]} {
+        set tagName [string trimleft $tagName "/"]
+        set tagType "end"
+    }
+    
+    if {$tagName!=[string trimright $tagName "/"]} {
+        set tagName [string trimright $tagName "/"]
+        set tagType "simple"
+    }
+    
+    
+    # Extract rawAttributes
+    set rawAttributes [join [lrange [split $contentTag " "] 1 end] " "]
+    set rawLine $rawAttributes
+    if {$rawAttributes!=[string trimright $rawAttributes "/"]} {
+        set rawAttributes [string trimright $rawAttributes "/"]
+        set tagType "simple"
+    }
+
+    
+    # The easiest way to split attributes and take into account the possibility not to quote one word long attribute
+    # is to split list of attributes using "=". The result is a list of couple : value(n) attrName(n+1) except for
+    # the first one and the last one
+
+    set rawAttributes [split $rawAttributes "="]
+    set attributes ""
+    set dummy 1
+    foreach element $rawAttributes {  # Parsing rawAttributes to get a proper list 
+        set element [string trim $element]
+        
+        set length1 [llength [split $element {"}]]
+            
+        #" This comment purpose is to correct syntaxic coloration with eclipse
+            
+        set length2 [llength [split $element " "]]
+        if {$length1 == 1} { # No quote in element
+            if {$length2 == 1} { # First param or last value
+                if {$dummy == 1 || $dummy == [llength $rawAttributes]} {
+                    lappend attributes [string trim $element]
+                } else {
+                    error "Error during parsing XML : attributes seem not to be well-formed in tag : $tagName \n The parser doesn't understand ...$element..."
+                }
+            }
+            if {$length2 == 2} { # is |value(n) param(n+1)|
+                set value [string trim [lindex $element 0]]
+                set param [string trim [lindex $element end]]
+                lappend attributes $value
+                lappend attributes $param
+                
+            }
+            if {$length2 > 2} { # Problem in parsing
+                warning "During parsing XML : attributes seem not to be well-formed in tag : $tagName near ...$element... \n It seems that one value for an attribute contains a white space but no quotes to surround it \n The parser has tried to continue but that could lead to errors or unexpected results"
+                if {$dummy == [llength $rawAttributes]} {
+                    set value [string trim $element]
+                    lappend attributes $value
+                } elseif {$dummy == 1} {
+                    error "Error during parsing XML : attributes seem not to be well-formed in tag : $tagName near $element..."
+                } else {
+                    set value [string trim [lrange $element 0 end-1]]
+                    set param [string trim [lindex $element end]]
+                    lappend attributes $value
+                    lappend attributes $param
+                }
+            }
+        } elseif {$length1 == 3} { # Two quotes in element
+            set element [string trim $element]
+            if {[lindex [split $element {}] 0] == {"}} { # element begins with a quote
+                if {[lindex [split $element {}] end] == {"} && $dummy == [llength $rawAttributes]} { # element finish with a quote and it's the final element
+                    set value [string trim [lindex [split $element {"}] 1]]
+                    lappend attributes $value
+                } elseif { $dummy > 1 && $dummy < [llength $rawAttributes]} { # element is made of two elements, the first one surrounded by quotes
+                    set element [split $element {"}]
+                    #" this comment is present to avoid editors to detect unexistant strings
+                    set value [string trim [lindex $element 1]]
+                    set param [string trim [lindex $element 2]]
+                    lappend attributes $value
+                    lappend attributes $param
+                } else {
+                    error "Error : During parsing XML : attributes seem not to be well-formed in tag : $tagName . It may be misplaced quotes in ...$element..."
+                }
+            } else {
+                error "Error : During parsing XML : attributes seem not to be well-formed in tag : $tagName near ...$element... \n It may be caused by misplaced quotes"
+            }
+            
+            
+        } else {
+            # It appears there are equals in the arguments, rawArgument needs to be parsed by a more specific and more restrictive parser
+            AnalyseStrictRawArguments
+            break
+            #error "Error with quotes in tag : $tagName near ...$element..."
+        }
+        incr dummy
+    }
+    
+    if {$fileType == "folderParameters"} {
+        set attributes_temp $attributes
+        set attributes ""
+        foreach {key value} $attributes_temp {
+            if {$key != "name"} {
+                lappend attributes $key
+                lappend attributes $value
+            }
+        }
+        lappend attributes "name"
+        lappend attributes "folderParameters"
+        set fileType "XMLtree"
+    }
+    
+    if {$fileType == "XMLtree"} {
+        # Act on the tree depending on tag type
+        switch $tagType {
+            simple {
+                XMLnewNode $tagName $attributes currentNodes tree
+                XMLendNode $tagName currentNodes tree
+            }
+            
+            begin {
+                XMLnewNode $tagName $attributes currentNodes tree
+            }
+            
+            end {
+                XMLendNode $tagName currentNodes tree
+            }
+        }
+    }
+    
+    if {$fileType == "DStree"} {
+        switch $tagType {
+            simple {
+                modelNewNode $tagName $attributes currentNodes tree
+                modelEndNode $tagName currentNodes tree
+            }
+            
+            begin {
+                modelNewNode $tagName $attributes currentNodes tree
+            }
+            
+            end {
+                modelEndNode $tagName currentNodes tree
+            }
+        }
+    }
+}
+
+proc AnalyseStrictRawArguments {} {
+    uplevel 1 {
+        set attributes ""
+        set rawAttributes [split $rawLine {"}]
+            
+        if {[llength $rawAttributes] % 2 == 0} {error "The parser was unable to retrieve the structure of [join $rawAttributes {"}] "} 
+            
+        
+        for {set i 0} {$i < [expr [llength $rawAttributes]-2 ]} {incr i ; incr i} {
+            set rawArg [lindex $rawAttributes $i]
+            set value [lindex $rawAttributes [expr $i + 1]]
+            
+            set rawArg [string trim $rawArg]
+            set arg [string trimright $rawArg "="]
+            if {$arg == $rawArg} {error "Equal missing in XML file near $rawArg"}
+            set arg [string trim $arg]
+            set value [string trim $value]
+            
+            lappend attributes $arg
+            lappend attributes $value
+        }
+            
+    }
+}
+
+
+
+proc parseFile {fileName itree startNode fileType} {
+    # This function reads an OpenTeaXML file whose format is fileType and insert it into tree under the node startNode 
+    # Please note that startNode has to be a list of 2-elements lists {node type (eg. model, param, etc))  and node name }
+    
+    upvar $itree tree
+    set currentNodes $startNode
+    
+    # Read XML file
+    set filePointer [open [file join $fileName]]
+    set XMLfile [read $filePointer]
+    close $filePointer
+    
+    # Remove comments
+    regsub -all {<!--.*?-->} $XMLfile {} XMLfile
+    
+    # Remove xml info
+    regsub -all {<\?.*?\?>} $XMLfile {} XMLfile    
+    
+    # include XML files if any
+    #set inclusion [lsearch -glob $XMLfile  "#!include"]
+    #puts "position $inclusion "
+    #set fileInclude [ lindex $XMLfile $inclusion+1]
+    #set filePointer [open [file join $fileInclude ]]
+    #set XMLfileInclude [read $filePointer]
+    #close $filePointer
+    ##set XMLfile [lrange $XMLfile 0 end]
+    #set XMLfile [lreplace $XMLfile $inclusion $inclusion+1  [join $XMLfileInclude] ]
+    #puts "xxx"
+    #puts "$XMLfile"
+    #exit
+    
+    # Explode XMLfile
+    set XMLfile [split $XMLfile ""]
+    
+    # Initialize some dummy variables
+    set previousChar ""
+    
+    # Initialize states
+    set tagState "out"
+    set valueState "out"
+    
+    # Initialize buffers
+    set tagBuffer ""
+    set contentBuffer ""
+    
+    # states descriptors
+    #   - tagState
+    #       "out"   : waiting for smthg to happen
+    #       "in"    : insideTag
+    #   - valueState
+    #       "out"   : out of a string
+    #       "in"    : in a string, special char are automatically escaped
+    
+    foreach char $XMLfile {
+        switch $tagState {
+            "out" {
+                if {$char=="<" && $previousChar!="\\"} { # Entering a tag
+                    set tagState "in"
+                    set tagBuffer ""
+                    XMLaddContent $contentBuffer currentNodes tree
+                    set contentBuffer ""
+                } else { # Still out a tag
+                    if {$char == " " && $previousChar == " "} {
+                        # don't store character
+                    } elseif {$char == "\t"} {
+                        # don't store character et keep the previousChar
+                        set char $previousChar
+                    } elseif {$previousChar != "\\" && $char == "\\"} {
+                        # don't store
+                    } elseif {$char == "\n" && $previousChar != "\n"} {
+                        #don't store
+                        append contentBuffer " "
+                    } else {
+                        append contentBuffer $char
+                    }
+                }
+            }
+            "in" {
+                if {$char==">" && $previousChar!="\\" && $valueState=="out"} { # Leaving a tag
+                    set tagState "out"
+                    # Tag is now well-known, it is send to a special procedure 
+                    analyseTag $tagBuffer tree currentNodes $fileType
+                } else { # Still in a tag
+                    append tagBuffer $char
+                }
+            }
+            
+        }
+        
+        switch $valueState {
+            "out" {
+                if {$char=="\"" && $previousChar!="\\"} { # Entering a tag
+                    set valueState "in"
+                }
+            }
+            "in" {
+                if {$char=="\"" && $previousChar!="\\"} {
+                    set valueState "out"
+                }
+                }
+            
+        }
+        set previousChar $char
+    }
+    
+    # At the end currentNodes has to be equal to startNode, otherwise, it means that end tags are missing in the XML file
+    if {$currentNodes != $startNode} {
+        set msg_err "Error in the XML file $fileName : closing tag is missing for node $currentNodes "
+        popup_error $msg_err strict
+    }
+    
+    # At the end of the file, valueState has to be equal to out. If not, that means a tag isn't closed properly
+    if {$valueState == "in"} {
+        set msg_err "Error : in the file $fileName, a tag is not properly closed (Normally, this one : [lindex [split $tagBuffer { }] 0])"
+        popup_error $msg_err strict
+    }
+}
+
+
+proc dir2tree {modelPath startNode itree} {
+    # This function create a subtree of the path "modelPath" and add it to the tree itree under the node startNode
+    # Please note that the node has to be a list of the ancestors (without "root")
+    upvar $itree tree
+    set currentPath [file join $modelPath [join $startNode [file separator]]]
+    set files [lsort [glob -nocomplain -tails -directory $currentPath *]]
+    
+    foreach fileid $files {
+        # fileid is a directory
+        if {[lindex [split $fileid ""] 0] == "."} {
+            continue
+        }
+        if {[file isdirectory [file join $currentPath $fileid]]} {
+            if { [glob -nocomplain -tails -directory [file join $currentPath $fileid] *.xml] == "" && [glob -nocomplain -directory [file join $currentPath $fileid] -type d *] == "" } {
+                continue
+            }
+            set currentNode [concat $startNode $fileid]
+            # Adds this directory to the tree
+            dTree_addNode tree [concat "root" $startNode] $fileid
+            dTree_setAttribute tree [concat "root" $startNode $fileid] nodeType "folder"
+            dTree_setAttribute tree [concat "root" $startNode $fileid] name "$fileid"            
+            
+            # reads the directory
+            dir2tree $modelPath $currentNode tree
+            
+        } else {
+            if {[file extension [file join $currentPath $fileid]] == ".xml" } {
+                # fileid is a XML file
+                set startNodeXML ""
+            
+                # Translates the format of the node from dir2tree format to file2tree format
+                foreach value $startNode {
+                    lappend startNodeXML [list "directory" $value]
+                }
+                
+                if {[file tail [file join $currentPath $fileid]] == "folderParameters.xml"} {
+                    parseFile [file join $currentPath $fileid] tree $startNodeXML "folderParameters"
+                } else {
+                    if {[lindex [lindex $startNodeXML end] end] == "DATA" && "1"=="0"} {
+                        parseFile [file join $currentPath $fileid] tree $startNodeXML "DStree"                        
+                    } else {
+                        parseFile [file join $currentPath $fileid] tree $startNodeXML "XMLtree"
+                    }
+                }
+            }
+        }
+    }
+    
+}
+
+
+proc OpenTeaXML2tree {itree modelPath dataPath} {
+    upvar $itree tree
+    dTree_init tree
+
+    # check if modelPath exists
+    if {![file isdirectory $modelPath]} {
+        error "The folder containing the XML files cannot be found. Should be : $modelPath"
+    }
+
+    # add solver directory
+    dir2tree $modelPath "" tree
+			    
+    # add DATA node
+    dTree_addNode tree "root" DATA
+    dTree_setAttribute tree "root DATA" nodeType "folder"
+    dir2tree [file join $dataPath] DATA tree
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/c3sm.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/c3sm.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/c3sm.tcl	(revision 4775)
@@ -0,0 +1,116 @@
+#  Ce programme depend des accords l'ACCORD DE COOPERATION AVBP (N. IFP 31.293). Voir la fin du programme pour plus de details.
+
+
+
+global additionalWidgets
+
+
+set pathEngine [file normalize [file dirname [info script]]]
+
+
+# Presonalization of C3Sm 
+image create photo icon_gui_small -file [file join $pathEngine IMAGES_PRIV logo_c3sm_small.gif]
+image create photo icon_gui_tiny -file [file join $pathEngine IMAGES_PRIV logo_c3sm_tiny.gif]
+
+# icones d'application
+image create photo icon_hmg -file [file join $pathEngine IMAGES_PRIV logo_hmg.gif]
+image create photo icon_mspec -file [file join $pathEngine IMAGES_PRIV logo_mspec.gif]
+image create photo icon_flammable -file [file join $pathEngine IMAGES_PRIV logo_flammable.gif]
+image create photo icon_calc -file [file join $pathEngine IMAGES_PRIV logo_calc.gif]
+image create photo icon_flow -file [file join $pathEngine IMAGES_PRIV logo_flow.gif]
+image create photo icon_flowtpf -file [file join $pathEngine IMAGES_PRIV logo_flowtpf.gif]
+
+
+# for the config and the footer of the app
+# entreprises
+
+image create photo icon_coria -file [file join $pathEngine IMAGES_PRIV logo_coria.gif]
+image create photo icon_imft -file [file join $pathEngine IMAGES_PRIV logo_imft.gif]
+image create photo icon_em2c -file [file join $pathEngine IMAGES_PRIV logo_em2c.gif]
+image create photo icon_ifpen -file [file join $pathEngine IMAGES_PRIV logo_ifpen.gif]
+
+# snecma
+image create photo icon_snecma -file [file join $pathEngine IMAGES_PRIV logo_snecma.gif]
+image create photo icon_turbomeca -file [file join $pathEngine IMAGES_PRIV logo_turbomeca.gif]
+image create photo icon_herakles -file [file join $pathEngine IMAGES_PRIV logo_herakles.gif]
+image create photo icon_gdtech -file [file join $pathEngine IMAGES_PRIV logo_gdtech.gif]
+
+
+
+###############################
+# Additionnal widget must be of the form "create_mywidget.tcl", stored in folder SOURCES_PRIV
+# The node "mywidget" will be automatically recognized
+
+
+# widget for the coolant GUI
+lappend additionalWidgets "coolac"
+
+
+
+
+
+
+
+source [file join $pathEngine "opentea.tcl"]
+
+
+
+#  Copyright CERFACS-IFP-SAFRAN 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  Ce logiciel est un programe informatique dont l'objectif est de proposer
+#  des outils numeriques pour l'etude de la combustion, des turbomachines,
+#  de l'acoustique, de la thermique et du rayonmment.
+#   
+#  Ce logiciel est gouverne par l'ACCORD DE COOPERATION AVBP (N. IFP 31.293)
+#  sous loi francaise, et fait explicitement partie de la -version commune- d'AVBP.
+#   
+#  Ce logiciel est la copropriete de CERFACS, SAFRAN et l'IFPEN, nommees ci apres les Parties,
+#  dans les termes de l'ACCORD DE COOPERATION AVBP.
+#  En cela:
+#  -  Chaque Partie pourra utiliser la -version commune- du code AVBP
+#  incluant la modalite 1 et la modalite 2 pour ses besoins propres
+#  de recherche librement, gratuitement, et sans limitation de duree.
+#  Par besoins propres de recherche, on entend une utilisation en
+#  interne de la -version commune- du code AVBP par une Partie pour
+#  des activites commerciales.
+#   
+#  -le CERFACS et l'IFPEN pourront librement entreprendre l'exploitation
+#  commerciale de la -version commune- du code AVBP incluant la modalite 1
+#  et la modalite 2 en toute independance et gratuitement a l'egard de
+#  l'autre partie, sous reserve de ne pas l'utiliser au profit de concurrents
+#  de SAFRAN ni de la diffuser a des tiers sous quelque forme que ce soit.
+#   
+#  -SAFRAN pourra exploiter librement la -version commune- du code AVBP
+#  incluant la modalite 1 dans le cadre de son activite d'etude et de
+#  conception de ses produits, sous reserve de ne pas l'utiliser au profit
+#  de concurrents du CERFACS et le l'IFP, ni de la diffuser a des tiers
+#  sous quelque forme que ce soit.
+#   
+#  L'utilisation de la -version commune- du code AVBP sera aux seuls
+#  risques de la partie exploitante et sous la seule responsabilite de
+#  la dite Partie. La -version commune- et toute documentation eventuelle
+#  y afferente sont fournis en l'etat, sans garantie d'aucune sorte.
+#  Nottament, aucune garantie en ce qui concerne l'utilisation initerrompue
+#  du code, ou les resultats obtenus lors de l'utilisation de la
+#  -version commune-, que ce soit leur exactitude, fiabilite ou autre,
+#  ou la jouissance paisible de la -version commune- n'est donnee.
+#  En consequence chacune des parties renonce a tout recours vis a vis des
+#  autres parties en ce qui concerne les consequences resultant de
+#  l'utilisation de la -version commune-, de quelque nature que ce soit. 
+#   
+#  A cet egard  l'attention de l'utilisateur est attiree sur les risques
+#  associes au chargement,  a l'utilisation,  a la modification et/ou au
+#  developpement et a la reproduction du logiciel par l'utilisateur etant 
+#  donne sa specificite de logiciel scientifique, qui peut le rendre complexe a 
+#  manipuler et qui le reserve donc a des developpeurs et des professionnels
+#  avertis possedant  des  connaissances  informatiques approfondies. Les
+#  utilisateurs sont donc invites a charger et tester l'adequation  du
+#  logiciel a leurs besoins dans des conditions permettant d'assurer la
+#  securite de leurs systemes et ou de leurs donnees et, plus generalement, 
+#  a l'utiliser et l'exploiter dans les memes conditions de securite. 
+#   
+#  Le fait que vous puissiez acceder a cet en-tete signifie que vous avez 
+#  pris connaissance de l'ACCORD DE COOPERATION AVBP, et que vous en avez
+#  accepte les termes.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/color_utilities.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/color_utilities.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/color_utilities.tcl	(revision 4775)
@@ -0,0 +1,236 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc shadeColor { colorname shade} {
+   set color [winfo rgb . $colorname]
+   set R [lindex $color 0]
+   set G [lindex $color 1]
+   set B [lindex $color 2]
+   
+   set DR [expr {65535 - $R}]
+   set DG [expr {65535 - $G}]
+   set DB [expr {65535 - $B}]
+   
+   set newR [expr { int($R+ $DR*$shade)}]
+   set newG [expr { int($G+ $DG*$shade)}]
+   set newB [expr { int($B+ $DB*$shade)}]
+   
+   
+   set color [format "#%04x%04x%04x" $newR $newG $newB]
+   return $color
+}
+
+
+proc RGBtoCOLCODE {col} {
+   set x [lindex $col 0]
+   set y [lindex $col 1]
+   set z [lindex $col 2]
+   set x [expr int($x)]
+   set y [expr int($y)]
+   set z [expr int($z)]
+   set color [format "#%02x%02x%02x" $x $y $z]
+  return $color
+}
+
+proc mix_color {mix_color} {
+   set ftot 0
+   foreach { f r g b} $mix_color {
+        set ftot [expr {$ftot+$f*1.}]
+   }
+   if {$ftot == 0.} {return {0 0 0}}
+   set red 0.
+   set green 0.
+   set blue 0.
+   foreach { f r g b} $mix_color {
+        set red [expr {$red+$f*1./$ftot*$r}]
+        set green [expr {$green+$f*1./$ftot*$g}]
+        set blue [expr {$blue+$f*1./$ftot*$b}]
+   }
+   set result [list $red $green $blue]
+    return $result
+}
+
+proc max_color { col } {
+   set x [lindex $col 0]
+   set y [lindex $col 1]
+   set z [lindex $col 2]
+   
+
+   set dx [expr {1.*$x/100.}]
+   set dy [expr {1.*$y/100.}]
+   set dz [expr {1.*$z/100.}]
+   
+   set done 0
+   while {$done ==0} {
+      set x [expr {$x+$dx}]
+      set y [expr {$y+$dy}]
+      set z [expr {$z+$dz}]
+      if { $x >= 255. } {
+         set x 255
+         set done 1
+      }
+      if { $y >= 255. } {
+         set y 255
+         set done 1
+      }
+      if { $z>= 255. } {
+         set z 255
+         set done 1
+      }
+      set x [expr int($x)]
+      set y [expr int($y)]
+      set z [expr int($z)]
+   }
+   
+   set result [list $x $y $z]
+   return $result
+   
+}
+
+
+
+
+proc colorscale_define { name } {
+    
+    set colorscale ""
+    
+    switch $name {
+         "rainbow" {
+            lappend colorscale {0.00 0.0 0.0 1.0}
+            lappend colorscale {0.25 0.0 1.0 1.0}
+            lappend colorscale {0.50 0.0 1.0 0.0}
+            lappend colorscale {0.75 1.0 1.0 0.0}
+            lappend colorscale {1.00 1.0 0.0 0.0}
+         }
+         "Xrainbow" {
+            lappend colorscale {0.00 0.0 0.0 0.0}
+            lappend colorscale {0.166 0.0 0.0 1.0}
+            lappend colorscale {0.333 0.0 1.0 1.0}
+            lappend colorscale {0.50 0.0 1.0 0.0}
+            lappend colorscale {0.666 1.0 1.0 0.0}
+            lappend colorscale {0.833 1.0 0.0 0.0}
+            lappend colorscale {1.00 1.0 1.0 1.0}
+         }
+        default {
+            lappend colorscale {0.0 0 0 0}
+            lappend colorscale {1.0 1.0 1.0 1.0}
+        }
+    }
+    
+    return $colorscale
+}
+
+
+
+proc colorscale_get { colorscale value } {
+    
+    set R1 ""
+    set G1 ""
+    set B1 ""
+    set R2 ""
+    set G2 ""
+    set B2 ""
+    set len [llength $colorscale]
+    set arm "no"
+    for {set i 0} {$i < $len} {incr i} {
+        set j [expr {$i+1}]
+        set V1 [lindex [lindex $colorscale $i] 0 ]
+        set R1 [lindex [lindex $colorscale $i] 1 ]
+        set G1 [lindex [lindex $colorscale $i] 2 ]
+        set B1 [lindex [lindex $colorscale $i] 3 ]
+        set V2 [lindex [lindex $colorscale $j] 0 ]
+        set R2 [lindex [lindex $colorscale $j] 1 ]
+        set G2 [lindex [lindex $colorscale $j] 2 ]
+        set B2 [lindex [lindex $colorscale $j] 3 ]
+        if {$value > $V1 && $value <= $V2} {
+            set A [expr {($value - $V1)*1./($V2 - $V1)}]
+            set R [expr { int(255.* ($A*$R2 +(1.0-$A)*$R1))}]
+            set G [expr { int(255.* ($A*$G2 +(1.0-$A)*$G1))}]
+            set B [expr { int(255.* ($A*$B2 +(1.0-$A)*$B1))}]
+            break
+        } elseif {$value == $V1} {
+            set R [expr { int(255.*$R1)}]
+            set G [expr { int(255.*$G1)}]
+            set B [expr { int(255.*$B1)}]
+            break               
+        } else {
+            set R 0
+            set G 0
+            set B 0
+        }
+        
+    }
+    return [format "#%02x%02x%02x"  $R $G $B] 
+}
+
+
+proc randcolor {} {
+    set r [expr { int(256 * rand()) }]
+    set g [expr { int(256 * rand()) }]
+    set b [expr { int(256 * rand()) }]
+
+    set gap [expr {300 - $r -$g -$b }]
+    if {$gap > 0} {
+        set plus [expr {int($gap*1./3.)}]
+        incr r $plus
+        incr g $plus
+        incr b $plus
+    }
+    
+    set newColor [format "#%02x%02x%02x" $r $g $b]
+    return $newColor
+}
+
+proc blendcolor { c1 c2 c3} {
+    #puts "blending $c1 $c2 $c3"
+    set R1 [expr 0x[string range $c1 1 2]]
+    set G1 [expr 0x[string range $c1 3 4]]
+    set B1 [expr 0x[string range $c1 5 6]]
+    set R2 [expr 0x[string range $c2 1 2]]
+    set G2 [expr 0x[string range $c2 3 4]]
+    set B2 [expr 0x[string range $c2 5 6]]
+    set R3 [expr 0x[string range $c3 1 2]]
+    set G3 [expr 0x[string range $c3 3 4]]
+    set B3 [expr 0x[string range $c3 5 6]]
+    
+    set r [expr {int(($R1 +$R2 +$R3)*1./3)}]
+    set g [expr {int(($G1 +$G2 +$G3)*1./3)}]
+    set b [expr {int(($B1 +$B2 +$B3)*1./3)}]
+    
+    set newColor [format "#%02x%02x%02x" $r $g $b]
+    return $newColor  
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/config.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/config.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/config.tcl	(revision 4775)
@@ -0,0 +1,64 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc getConfig {address} {
+    # This function retrieves the config file, selects the relevant element from address (without the "root") and return its value
+    
+    global configPath configTree
+    
+    # Retrieve the file if it has not been done yet
+    if {$configTree == ""} {
+        dTree_init configTree
+        if {[file exists $configPath]} {
+            parseFile $configPath configTree "" "DStree"
+        } else {
+            close [open $configPath "w"]
+            return ""
+        }
+        
+    }
+
+    if {![dTree_nodeExists $configTree "root dataset config"]} {
+        popup_error "Config file is empty..."
+    }
+    
+    if {[catch {set value [dTree_getAttribute $configTree "root dataset $address" value]} err]} {
+        #error "The address $address doesn't exist in the config tree"
+        return ""
+    }
+    
+    return $value
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_action.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_action.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_action.tcl	(revision 4775)
@@ -0,0 +1,199 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc action_create { args } {
+    global codesPath defaultSolver solverPath
+    set mandatory_arguments { path_father address }
+    initWidget
+    set widgetInfo($address-title) [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    set widgetInfo($address-args) [split [dTree_tryGetAttribute $XMLtree $full_address_XML "script_args" ""] ";"]
+    set widgetInfo($address-blocking) [split [dTree_tryGetAttribute $XMLtree $full_address_XML "status_blocking" "yes"] ";"]
+    
+    set widgetInfo($address-starttime) "0"
+    set widgetInfo($address-endtime) "0"
+    
+    
+    #smartpacker_setup_modelframe $win $address
+    ttk::frame $win
+    eval $widgetInfo(packme-$win)
+    
+    ttk::frame $win.action
+    ttk::frame $win.infos    
+    
+    
+   
+    set script [dTree_getAttribute $XMLtree $full_address_XML "script"]
+    set widgetInfo($address-scriptAddress) [file join $solverPath scripts $script]
+    if {![file exists $widgetInfo($address-scriptAddress)]} {
+        error "File not found : \n$widgetInfo($address-scriptAddress)"
+    }
+    
+    
+    
+    #ttk::label $win.title  -width -10 -text $title 
+    ttk::label $win.action.status -width -20 -textvariable widgetInfo($address-status_txt) -justify left -compound left
+    ttk::progressbar $win.action.progress  -mode indeterminate 
+    $win.action.progress stop
+    ttk::button $win.action.launch -text $widgetInfo($address-title) -command [subst {
+        log "\n@@@@@@@@ Process Action '$widgetInfo($address-title)' @@@@@@@"
+        openPipe $win $address
+    }]
+    #
+    set widgetInfo($address-progressValue) 0    
+    
+    
+    ############################
+    # Adding script node 
+    emptyNode_create -path_father $win -address $address.scriptNode
+    append widgetInfo($address.scriptNode-refresh) [subst { set widgetInfo($address.scriptNode-status) \[ expr (\$widgetInfo($address.scriptNode-variable)+1)/2]}]
+
+    #pack $win -pady 5
+    
+    #grid $win.action -sticky news -column 0 -row 0
+    pack $win.action -side top -fill x -expand 1  
+    pack $win.action.launch -side top  -expand 1  
+    pack $win.action.progress -side top  -expand 1  
+    pack $win.action.status -side top  -expand 1  
+    
+    pack $win.infos -side top -fill x -expand 1  
+    #grid $win.infos -sticky news -column 0 -row 1
+    
+    #grid columnconfigure $win $win.infos -weight 1
+        
+    append widgetInfo($address-refresh) [subst { action_refresh $win $address }]
+    append widgetInfo($address-refreshStatus) [subst { action_refreshStatus $win $address }]
+    
+    set widgetInfo($address-onScriptStarts) [subst {
+        $win.action.status configure -image icon_void -foreground black
+        set widgetInfo($address-cancellation) 0
+        if {\$widgetInfo($address-status) == -1} {
+            set widgetInfo($address-cancellation) 0
+            set widgetInfo($address-status_txt) "Warning, status was initially wrong.."
+        } else {
+            $win.action.progress start
+            set widgetInfo(action-callingAddress) $address
+            $win.action.launch configure -text "Escape to Abort"
+            #$win.action.launch configure -command "stopScript $win $address"
+        }
+    }]
+    
+    set widgetInfo($address-onScriptStops) [subst {
+        $win.action.progress configure -mode indeterminate         
+        $win.action.progress stop
+        $win.action.launch configure -text "$widgetInfo($address-title)"
+        $win.action.launch configure -command "openPipe $win $address"
+        set widgetInfo($address.scriptNode-status) -1
+        set widgetInfo($address.scriptNode-variable) 0
+        eval \$widgetInfo($address.scriptNode-check)
+        action_refreshStatus $win $address
+        Stop_think normal
+    }]
+    
+    set widgetInfo($address-updateProgress) [subst {
+         $win.action.progress stop            
+         $win.action.progress configure -mode determinate -value \$widgetInfo($address-progressValue)
+         
+     }]    
+    
+    set widgetInfo($address-onScriptEnds) [subst {
+        $win.action.progress configure -mode indeterminate          
+        $win.action.progress stop
+        $win.action.launch configure -text "$widgetInfo($address-title)"
+        $win.action.launch configure -command "openPipe $win $address"
+        set widgetInfo($address.scriptNode-status) 1
+        set widgetInfo($address.scriptNode-variable) 1
+        eval \$widgetInfo($address.scriptNode-check)
+        action_refreshStatus $win $address
+        Stop_think normal
+        }]
+    
+    set widgetInfo($address-status) "-2"
+    if {[dTree_attrExists $XMLtree $full_address_XML "initstatus"]  == 1 } {
+        set widgetInfo($address-status) "1"
+    }
+    
+    action_refreshStatus $win $address
+    finishWidget
+    return $win.infos
+}
+
+proc action_refreshStatus {win address} {
+    global widgetInfo
+    
+    set duration  [printtime $widgetInfo($address-starttime) $widgetInfo($address-endtime) ]                    
+
+  
+    switch $widgetInfo($address.scriptNode-status) {
+        "-1" {$win.action.status configure -image icon_error -foreground red
+            set widgetInfo($address.scriptNode-status) -1
+            set widgetInfo($address-progress) 0
+            set widgetInfo($address-status_txt) "Execution error : check logs. Took $duration s."
+            set widgetInfo($address-variable) 0
+        }
+        "1" {$win.action.status configure -image icon_ok -foreground green4
+            set widgetInfo($address.scriptNode-status) 1            
+            set widgetInfo($address-progress) 100
+            set widgetInfo($address-status_txt) "Done in $duration s."
+            set widgetInfo($address-variable) 1
+        }
+        "-2" {$win.action.status configure -image icon_void -foreground black
+            set widgetInfo($address-progress) 100
+            
+            set widgetInfo($address-status_txt) "Waiting for launch"
+            set widgetInfo($address-variable) 1
+            set widgetInfo($address.scriptNode-status) -2            
+        }
+        default {$win.action.status configure -image icon_void -foreground black
+            set widgetInfo($address-progress) 0
+            set widgetInfo($address-status_txt) ""
+            set widgetInfo($address-variable) 0
+            set widgetInfo($address.scriptNode-status) 0            
+        }
+    }
+    
+    smartpacker_update_visibility $win $address
+    
+    if {$widgetInfo($address-blocking) =="no"} {
+        set widgetInfo($address-status) 1
+        set widgetInfo($address.scriptNode-status) 1
+    }
+    
+}
+
+proc action_refresh {win address} {
+    # take the variable value from DStree to see if the run has already be done
+    
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_browser.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_browser.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_browser.tcl	(revision 4775)
@@ -0,0 +1,256 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+proc browser_create { args } {
+    set mandatory_arguments { path_father address }
+    initWidget
+    global workingDir
+    
+    ttk::frame $win -height 40p
+    eval $widgetInfo(packme-$win)
+    
+    #set title "[dTree_getAttribute $XMLtree $full_address_XML "title"]"
+    set widgetInfo($address-browsertype) "[dTree_getAttribute $XMLtree $full_address_XML "type"]" 
+    set widgetInfo($address-filter) [split [dTree_tryGetAttribute $XMLtree $full_address_XML "filter" "none" ] ";"] 
+    
+    
+    
+    smartpacker_setup_label $win $address
+    smartpacker_setup_status $win $address
+
+    
+    ttk::entry $win.entry  -textvariable widgetInfo($address-variable) 
+    #pack  $win.entry -side left
+    
+    bind $win.entry <FocusOut> [subst {browser_entry_cmd $address}]
+    bind $win.entry <Return> [subst {browser_entry_cmd $address}]
+    
+    #bind $win.entry <FocusOut> [subst {$win.entry xview moveto 1.}]
+    
+    ttk::button $win.butt -image icon_folder  -compound right -command  [subst {
+        browser_bsr_cmd $win $address "$title" 
+    }]
+    
+    
+    #pack $win.butt -side left
+    place $win.entry -relx 0.5 -rely 0. -anchor nw   -relwidth [expr {0.8*$widgetInfo(guiEntryRelWidth)}]
+    place $win.butt -relx [expr {0.5 + 0.8*$widgetInfo(guiEntryRelWidth)}] -rely 0. -relwidth [expr {0.2*$widgetInfo(guiEntryRelWidth)}] -anchor nw  
+    
+    append widgetInfo($address-refreshStatus) [ subst { browser_refreshStatus $win $address}]
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]    
+    finishWidget
+    
+    
+    
+    
+    
+    
+    # setup browser starts
+    set initialdircommand ""
+    #set browsemode [getConfig "config gui paths"]
+    #switch $browsemode {
+    #    "constant" {
+    #        set constdir [getConfig "config gui paths constant workingDir"]
+    #        set initialdircommand " -initialdir $constdir"
+    #    }
+    #    "auto" {
+    #        set initialdircommand " -initialdir $workingDir"
+    #    }
+    #    "last" {
+    #        set initialdircommand "" 
+    #    }
+    #    
+    #}
+    
+    # set up filters
+    set filtercommand " "
+    if {$widgetInfo($address-browsertype) in {"file" "multiple_files"} } {
+        if {$widgetInfo($address-filter) !="none"} {
+            set filterlist ""
+            foreach suffix $widgetInfo($address-filter) {
+                lappend filterlist "$suffix .$suffix"
+            }
+            set filtercommand " -filetypes \{$filterlist\}"
+            
+        } 
+    }
+    
+    if {$widgetInfo($address-browsertype) == "h5_asciiBound"} {
+        set filtercommand " -filetypes \{\{ \"mesh *.mesh.h5 + *.asciiBound\" \"*.h5\"\}\}"
+       
+    }    
+    
+    
+    # build callback
+    switch $widgetInfo($address-browsertype)  {
+        "file" {
+            set widgetInfo($address-callback) [subst { tk_getOpenFile -title \"$title\" $initialdircommand $filtercommand}]
+        }
+        "multiple_files" {
+            set widgetInfo($address-callback) [subst { tk_getOpenFile -title \"$title\" $initialdircommand $filtercommand -multiple 1}]
+        }
+        "h5_asciiBound" {
+            set widgetInfo($address-callback) [subst {tk_getOpenFile -title \"$title\" $initialdircommand $filtercommand}]
+        }
+        "folder" {
+            set widgetInfo($address-callback) [subst {tk_chooseDirectory -title \"$title\" $initialdircommand}]
+        }
+    }
+    
+    
+    
+    
+}
+
+
+# Command associated to entry
+proc browser_entry_cmd {address} {
+    global widgetInfo 
+    eval $widgetInfo($address-check)
+}
+
+# Command associated to browser
+proc browser_bsr_cmd { win address title} {
+    global widgetInfo  
+    
+    
+    set last_value $widgetInfo($address-variable)
+    set widgetInfo($address-variable) [eval $widgetInfo($address-callback)]
+    
+    if {$widgetInfo($address-variable) == ""} {
+        set widgetInfo($address-variable) $last_value
+    }
+    
+    if {[llength $widgetInfo($address-variable) ] > 1} {
+        set widgetInfo($address-variable) [string map {" " ";"} $widgetInfo($address-variable)]
+    }
+    
+    
+    eval $widgetInfo($address-check) 
+    
+}
+
+
+
+
+proc browser_refreshStatus {win address} {
+    global widgetInfo
+
+    if {$widgetInfo($address-variable)!=""} {
+        #set widgetInfo($address-variable) [ pathTo $widgetInfo($address-variable) [pwd]]
+    }    
+    if {$widgetInfo($address-browsertype) == "multiple_files"} {
+        set filename [lindex [split $widgetInfo($address-variable) ";"] 0]      
+    } else {
+        set filename $widgetInfo($address-variable)
+    }
+    
+    
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-status_txt) ""
+    
+     
+    
+    
+    if { [file exists $filename] == 0} {
+        set widgetInfo($address-status) -1
+        set widgetInfo($address-status_txt) "File not found"
+    }
+    
+    if { $widgetInfo($address-browsertype) == "h5_asciiBound" && [file exists $filename]} {
+        set asciiboundfile "[string range  $filename 0 end-8].asciiBound"
+        if {[file exists $asciiboundfile] == 0} {
+            set widgetInfo($address-status) -1
+            set widgetInfo($address-status_txt) "AsciiBound not found"
+            log "Error while loading mesh file \n $filename.\n Cannot find asciiBound file: \n $asciiboundfile \n"
+        }
+    }
+
+   
+    $win.status configure -image ""
+    
+    if { $filename == ""} {
+        set widgetInfo($address-status) -1
+        set widgetInfo($address-status_txt) "(...)"
+        $win.status configure -image icon_question
+    }
+    
+    if { $widgetInfo($address-status) == -1 &&  $widgetInfo($address-status_txt) != "(...)" } { 
+        $win.status configure -image icon_flag
+    } 
+    
+    smartpacker_update_visibility $win $address
+    update idletasks
+    $win.entry xview moveto 1.
+}
+
+
+
+# http://wiki.tcl.tk/15925
+# get relative path to target file from current file
+ # arguments are file names, not directory names (not checked)
+# CODE CHANGED : while {[string equal [lindex $cc 0] [lindex $tt 0]] && [llength $cc] > 1} {
+ 
+ proc pathTo {target current} {
+     set cc [file split [file normalize $current]]
+     set tt [file split [file normalize $target]]
+     if {![string equal [lindex $cc 0] [lindex $tt 0]]} {
+         # not on *n*x then
+         return -code error "$target not on same volume as $current"
+     }
+     while {[string equal [lindex $cc 0] [lindex $tt 0]] && [llength $cc] >= 1} {
+         # discard matching components from the front (but don't
+         # do the last component in case the two files are the same)
+         set cc [lreplace $cc 0 0]
+         set tt [lreplace $tt 0 0]
+     }
+     set prefix ""
+     if {[llength $cc] == 1} {
+         # just the file name, so target is lower down (or in same place)
+         set prefix "."
+     }
+     # step up the tree (start from 1 to avoid counting file itself
+     for {set i 1} {$i <= [llength $cc]} {incr i} {
+         append prefix " .."
+     }
+     # stick it all together (the eval is to flatten the target list)
+     return [eval file join $prefix $tt]
+ }
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_choice.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_choice.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_choice.tcl	(revision 4775)
@@ -0,0 +1,224 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+# create a choice dialog
+
+proc choice_create { args } {
+
+    set mandatory_arguments { path_father address }
+    initWidget
+
+      
+    ttk::frame $win 
+    eval $widgetInfo(packme-$win)
+    
+    smartpacker_setup_label $win $address
+    smartpacker_setup_status $win $address        
+    set widgetInfo($address-status) 1
+   
+    set widgetInfo($address-mode) "standard"
+    set widgetInfo($address-valuelist) ""     
+    set widgetInfo($address-titlelist) ""    
+   
+   
+    
+    if {[dTree_attrExists $XMLtree $full_address_XML_clean "source"]} {
+        set source "root [dTree_getAttribute $XMLtree $full_address_XML_clean "source"]"
+        set widgetInfo($address-mode) "source"
+        set children [dTree_getChildren_fast $XMLtree $source]
+        if {[llength $children] > 3} {
+            set widgetInfo($address-choicetype) "combobox"
+        } else {
+            set widgetInfo($address-choicetype) "radiobox"
+        }
+    } elseif { [dTree_attrExists $XMLtree $full_address_XML_clean "require"]} {
+        set widgetInfo($address-mode) "require"
+        
+        set widgetInfo($address-valuelist) $widgetInfo($address-requiredValue)        
+        set widgetInfo($address-titlelist) $widgetInfo($address-requiredValue)
+        set children $widgetInfo($address-valuelist)
+
+        set widgetInfo($address-choicetype) "combobox"
+        set widgetInfo($address-variable) [lindex $widgetInfo($address-valuelist) 0]
+        
+    } else {
+        set children [dTree_getChildren_fast $XMLtree $full_address_XML_clean  ]
+        if {[llength $children] > 3} {
+            set widgetInfo($address-choicetype) "combobox"
+        } else {
+            set widgetInfo($address-choicetype) "radiobox"
+        }
+    }
+    
+    
+    # initialize the widget
+    switch $widgetInfo($address-choicetype) {
+        "combobox" {
+            set widgetInfo($address-height) 40   
+            ttk::combobox $win.cbbox -textvariable widgetInfo($address-choice) -width 14 -state readonly
+            place $win.cbbox -relx 0.5 -rely 0.0 -anchor nw  -relwidth $widgetInfo(guiEntryRelWidth)
+            set widgetInfo($address-status) 1
+            append widgetInfo($address-check) [subst {choice_check $win $address}] 
+            append widgetInfo($address-refresh) [subst {choice_refresh $win $address}]
+            append widgetInfo($address-refreshStatus) [ subst { choice_refreshStatus $win $address}]
+            bind  $win.cbbox <<ComboboxSelected>> [subst {eval \$widgetInfo($address-check)}]
+            $win configure -height $widgetInfo($address-height)
+            
+        }
+        "radiobox" {
+            ttk::frame $win.butts        
+            set widgetInfo($address-height) 20   
+            set widgetInfo($address-choiceshift) 0 
+            place $win.butts -relx 0.5 -rely 0.0 -anchor nw  -relheight 1 -relwidth 0.5
+            set widgetInfo($address-status) 1
+            append widgetInfo($address-refreshStatus) [ subst { choice_refreshStatus $win $address}]    
+        } 
+    }
+   
+   
+    # in the case of a source, the create_gui will not loop acroos the children by itself
+    # this loop s then called inside the creation of the widget
+    if {$widgetInfo($address-mode) != "require"} {     
+        foreach child $children {
+            choice_add -path_father $win -address "$address.$child"
+        }
+        
+    }
+    
+    finishWidget
+
+    choice_refresh $win $address
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    return $win
+}
+
+# to add a new radiobutton to radiobox
+proc choice_add { args } {
+    global widgetInfo XMLtree
+    set mandatory_arguments {path_father address}
+    
+    # Get the widget informations
+    getinfoFatherWidget 
+    
+    incr widgetInfo($address_father-nboptions) 1
+    
+    
+    if {$widgetInfo($address_father-mode) != "standard"} {
+        set value [lindex $full_address_XML end]
+        set full_address_XML [lrange $full_address_XML 0 end-1]
+        set full_address_XML_clean [lrange $full_address_XML_clean 0 end-1]
+        
+        set title $value
+        set name "child_$name"
+    } else {
+        set value [dTree_getAttribute_fast $XMLtree $full_address_XML_clean "value"]
+        set title [string totitle [ join [ split $value "_" ] " " ] ]
+        if {[dTree_attrExists $XMLtree $full_address_XML_clean  "title"]} {
+            set title [dTree_getAttribute_fast $XMLtree $full_address_XML_clean  "title"]
+        }        
+    }    
+    
+    lappend widgetInfo($address_father-valuelist) $value
+    lappend widgetInfo($address_father-titlelist) $title  
+    switch $widgetInfo($address_father-choicetype) {
+        "radiobox" {
+            ttk::radiobutton $win_father.butts.$name -text $title -variable widgetInfo($address_father-variable)  -value $value -command [subst {eval \$widgetInfo($address_father-check)}]
+            place $win_father.butts.$name -x 0 -y $widgetInfo($address_father-choiceshift)  -relwidth 1 -anchor nw            
+            incr widgetInfo($address_father-choiceshift) 20
+            incr widgetInfo($address_father-height) 20
+            $path_father configure -height $widgetInfo($address_father-height)
+        }
+        "combobox" {
+            $win_father.cbbox configure -values $widgetInfo($address_father-titlelist) 
+        }        
+    }
+    
+}
+
+proc choice_check {win address} {
+    global widgetInfo
+    
+    # if combobox used , sync the choice of the combobox and the variable    
+    if { $widgetInfo($address-choicetype) == "combobox"} {
+        set widgetInfo($address-variable) [lindex $widgetInfo($address-valuelist) [$win.cbbox current]]
+        $win.cbbox selection clear
+    }
+    
+}
+
+proc choice_refresh {win address} {
+    global widgetInfo
+    if { $widgetInfo($address-mode)  == "require" } {   
+        set widgetInfo($address-valuelist) $widgetInfo($address-requiredValue)        
+        set widgetInfo($address-titlelist) $widgetInfo($address-requiredValue)
+        
+        
+        if {$widgetInfo($address-requiredValue) == ""} {
+            set widgetInfo($address-status_txt) "No choices available now"
+            set widgetInfo($address-status) -1
+        } else {
+            $win.cbbox configure -values $widgetInfo($address-titlelist) 
+            set widgetInfo($address-status_txt) ""
+            set widgetInfo($address-status) 1
+            if {[lsearch $widgetInfo($address-titlelist) $widgetInfo($address-variable)] == -1 } {
+                #warning "$widgetInfo($address-variable) is not in the list ( $widgetInfo($address-titlelist) )\n automatic switch to [lindex $widgetInfo($address-valuelist) 0] "
+                set widgetInfo($address-variable) [lindex $widgetInfo($address-valuelist) 0]
+            }
+        }
+    }
+    
+    if { $widgetInfo($address-choicetype) == "combobox"} {
+        $win.cbbox configure -values $widgetInfo($address-titlelist)
+        set widgetInfo($address-choice) [lindex $widgetInfo($address-titlelist) [lsearch -exact $widgetInfo($address-valuelist) $widgetInfo($address-variable)]]
+    }
+    
+}
+
+
+proc choice_refreshStatus {win address} {
+    global widgetInfo
+        
+    if { $widgetInfo($address-status) == -1 } { 
+        $win.status configure -image icon_flag
+    } else {
+        $win.status configure -image ""
+    }    
+    
+    smartpacker_update_visibility $win $address
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_cluster.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_cluster.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_cluster.tcl	(revision 4775)
@@ -0,0 +1,589 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc cluster_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget
+
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-renaming) 0
+    set widgetInfo($address-lastclick) [clock milliseconds]
+    set widgetInfo($address-ratio) [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "ratio" "0.5" ] 
+     
+            
+    if  {[dTree_attrExists $XMLtree $full_address_XML_clean "require"]==1} {
+        set widgetInfo($address-clustermode) "require"
+    } else {
+        if  {[dTree_attrExists $XMLtree $full_address_XML_clean "fixed"]==1} {
+            set widgetInfo($address-clustermode) "fixed"            
+        } else {
+            set widgetInfo($address-clustermode) "independant"
+        }
+    }
+    
+    
+    
+    ###############
+    # MAIN FRAMES #
+    ###############
+    
+    ttk::frame $win
+    eval $widgetInfo(packme-$win)
+    
+    
+    
+    
+    ttk::frame $win.ftv 
+    ttk::frame $win.ftv.forceps -width $widgetInfo(guiSmallWidgetWidth) -height 0 
+    pack $win.ftv -fill both -side left -expand 1 
+    ############
+    # TREEVIEW #
+    ############
+    
+    set title [dTree_getAttribute $XMLtree $full_address_XML_clean "title"]   
+    ttk::label $win.ftv.lb  -text "$title:" -anchor ne -justify right
+    
+    set widgetInfo($address-status) 0
+    set widgetInfo($address-status_txt) ""
+    ttk::label $win.ftv.status -textvariable widgetInfo($address-status_txt) -foreground "red" -justify center -compound left -anchor center
+    $win.ftv.status configure -wraplength [expr { 0.6*$widgetInfo(guiSmallWidgetWidth)}]
+    
+    
+    set widgetInfo($address-labelstype) [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "labels" "ascii"]
+    
+    ttk::treeview $win.ftv.tv -selectmode none -show {}
+    if {$widgetInfo($address-clustermode) == "independant"} {
+        $win.ftv.tv configure -selectmode browse
+    }
+    #yscrollcommand [list $win.ftv.sby set]  
+    # create the columns of the treeview    
+    
+    
+    #$win.ftv.lb configure -width "[expr {int([expr {1.* $widgetInfo(guiSmallWidgetWidth)}])}]p"
+    set colwidth [expr {int([expr {0.5* $widgetInfo(guiSmallWidgetWidth)}])}]
+    
+    
+    $win.ftv.tv configure -columns "lbl var"
+    $win.ftv.tv column #1 -width $colwidth -anchor e
+    $win.ftv.tv column #2 -width $colwidth -anchor w
+    
+    #ttk::scrollbar $win.ftv.sby -orient vertical -command [list $win.ftv.tv yview]
+    
+    # avoid tab scrolling for mousewheel
+    bind $win.ftv.tv <MouseWheel> {+set tabscroll 0}
+    bind $win.ftv.tv  <Leave> {+set tabscroll 1}
+    #bind $win.ftv.tv  <FocusOut> [subst {$win.ftv.tv selection set  {} }]
+    # ce binding est inutilisable ca il bloque la deletion d'un item
+    
+    
+    grid $win.ftv.lb -sticky ne -column 0 -row 0 
+    grid columnconfigure  $win.ftv  $win.ftv.lb  -weight 1
+    grid rowconfigure  $win.ftv  $win.ftv.lb  -weight 1
+    grid $win.ftv.tv -sticky e -column 1 -row 0 -rowspan 2
+    grid $win.ftv.forceps -sticky news -column 0 -row 3 -columnspan 2
+    grid $win.ftv.status -sticky news -column 0 -row 4 -columnspan 2
+    
+    
+    
+ 
+    
+
+    
+    
+    ############
+    # CONTROLS #
+    ############
+    ttk::frame $win.ftv.controls
+    grid $win.ftv.controls -sticky se -column 0 -row 1
+    grid columnconfigure  $win.ftv  $win.ftv.controls  -weight 1
+    grid rowconfigure  $win.ftv  $win.ftv.controls  -weight 1
+    
+    
+    #icons with buttons
+    ttk::button $win.ftv.controls.add -text "+" -command [subst {
+        cluster_ctrl_addcomponent $win $address
+        eval \$widgetInfo($address-check)   
+    }]
+    ttk::button $win.ftv.controls.rm  -text "-" -command [subst {
+        cluster_ctrl_rmcomponent $win $address
+        eval \$widgetInfo($address-check)   
+    }]
+    
+    
+    
+    if {$widgetInfo($address-clustermode)=="independant"} {
+       pack $win.ftv.controls.add $win.ftv.controls.rm -side right -anchor nw -padx 0 -pady 0      
+    }
+      
+   
+   
+    append widgetInfo($address-refreshStatus) [subst {cluster_refreshStatus $win $address}]
+    append widgetInfo($address-refresh) [subst {cluster_refresh $win $address}]
+    
+    
+    finishWidget
+    
+    cluster_refresh $win $address
+   
+    
+    # reaction to cells
+    bind $win.ftv.tv <ButtonPress> [subst {+cluster_simple_trigger $win $address %x %y}]
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+# Simple Click : raise the form relative to the component
+proc cluster_simple_trigger {win address x y} {
+    global widgetInfo
+    set row [$win.ftv.tv identify row $x $y]
+    set col [$win.ftv.tv identify column $x $y]
+    
+    set double_click "0"
+    set current_time_ms [clock milliseconds]
+    set delay [expr {$current_time_ms - $widgetInfo($address-lastclick)}]
+    set widgetInfo($address-lastclick) $current_time_ms
+    if {$delay <300 } {
+        set double_click 1
+    }
+    
+    
+    if {$col=="#1" && $widgetInfo($address-clustermode)!="independant"} { return 0}    
+    if {$row!= ""} {
+        
+        if { $widgetInfo($address-renaming) != 0 } {
+            cluster_setname $address $win $widgetInfo($address-renaming) $widgetInfo($address-renamingCol)
+            set widgetInfo($address-renaming) 0
+            destroy $win.ftv.tv.rename  
+        }
+        
+        if {$double_click} {
+            cluster_rename $win $address $row $col
+            
+        }
+        
+    }
+}
+
+
+
+
+# called by the "+" button is invoked
+proc cluster_ctrl_addcomponent {win address} {
+    global widgetInfo tmpTree
+    
+    set row [$win.ftv.tv selection ]
+    if { $row != "" } {
+        set rank [lsearch [cluster_component_list $address] $row]
+        incr rank
+    } else {
+        set rank "end"
+    }
+    cluster_new_component $win $address $rank
+    cluster_refreshStatus $win $address
+}
+
+proc cluster_ctrl_rmcomponent {win address } {
+    global widgetInfo
+     
+    
+    set row [$win.ftv.tv selection ]
+    if { $row != "" } {
+        set rank [lsearch [cluster_component_list $address] $row]
+    } else {
+        return
+    }
+    cluster_del_component $win $address $row
+    cluster_refreshStatus $win $address
+}
+
+
+
+# called when :
+# - "+" button is invoked
+# - a new component is needed
+proc cluster_new_component { win address rank   } {
+    global widgetInfo
+    set index 1
+    set lbl_ok 0
+    while {$lbl_ok == 0} {
+        
+        set rank [lsearch [cluster_component_list $address] "x_$index"]
+
+        if {$rank == -1} {
+            set lbl_ok 1
+        } else {
+            incr index
+        }
+    }
+    set newcontent [ linsert [cluster_variable_to_content $address] end "x_$index void"]
+    cluster_content_to_variable $address $newcontent
+}
+
+
+# called when :
+# - "-" button is invoked
+# - a  component must be deleted
+proc cluster_del_component { win address component_node } {
+    global widgetInfo 
+    
+    set rank [lsearch [cluster_component_list $address] $component_node]
+    # remove from the main cluster widget
+    
+    
+    
+    set newcontent [ lreplace [cluster_variable_to_content $address] $rank $rank  ]
+    cluster_content_to_variable $address $newcontent
+   
+}
+
+
+
+proc cluster_rename {win address row col } {
+    
+    global widgetInfo
+    if { $widgetInfo($address-renaming) != 0 } {
+        focus $win.ftv.tv.rename.entry
+        return    
+    }                    
+    
+    set widgetInfo($address-renaming) $row                    
+    set widgetInfo($address-renamingCol) $col
+    
+
+    
+    
+    frame $win.ftv.tv.rename -background red  -bd 2
+    set bbox [$win.ftv.tv bbox $row $col]
+    
+    place $win.ftv.tv.rename -x [lindex $bbox 0] -y [lindex $bbox 1] -width [lindex $bbox 2] -height [lindex $bbox 3]
+    
+    focus $win.ftv.tv.rename
+    
+    set widgetInfo($address-entry) [$win.ftv.tv set $row $col]
+    ttk::entry $win.ftv.tv.rename.entry -textvariable widgetInfo($address-entry) 
+    pack $win.ftv.tv.rename.entry -expand 1
+    $win.ftv.tv.rename.entry selection range 0 end
+    $win.ftv.tv.rename.entry icursor end
+    focus $win.ftv.tv.rename.entry
+
+
+    bind $win.ftv.tv.rename.entry <Return>  [ subst {
+        # change value
+        cluster_setname $address $win $row $col
+        # kill dialog
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]
+    
+    bind $win.ftv.tv.rename.entry <FocusOut>  [ subst {
+         # change value
+        cluster_setname $address $win $row $col
+        # kill dialog
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]
+    
+    
+    bind $win.ftv.tv.rename.entry <Escape>  [ subst {
+        # kill dialog
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]
+    
+    
+    #bind $win.ftv.tv.rename.entry <Tab>  [ subst {
+    #    
+    #    #change value
+    #    cluster_setname $address $win $row $col
+    #    # kill dialog
+    #    destroy $win.ftv.tv.rename
+    #    set widgetInfo($address-renaming) 0
+    #    
+    #    # find nex row
+    #    set list_row \[cluster_component_list $address\]
+    #    set rank \[lsearch \$list_row $row\]
+    #    incr rank
+    #    if {\$rank == \[llength \$list_row\]} {
+    #        set rank 0
+    #    }
+    #    set newrow \[lindex \$list_row \$rank\]
+    #    # restart dialog
+    #    cluster_rename $win $address \$newrow $col
+    #    puts "test"
+    #}]
+}
+
+
+
+# change the label assigned 
+proc cluster_setname { address win row col } {
+    global widgetInfo tmpTree
+    
+    
+   
+    set new_label [stringcleanBalise $widgetInfo($address-entry)]
+    set newcontent ""
+    
+    
+    if {$col == "#1"} {
+        set list_of_components [cluster_component_list $address]
+       
+        if {[lsearch $list_of_components $new_label ] != -1} {
+            warning "The component $new_label is already existing. Use another component."
+            return
+        }   
+    }
+    
+    foreach couple  [cluster_variable_to_content $address] {
+        set component [lindex $couple 0]
+        set vars [lrange  $couple 1 end]
+        if {$component ==$row } {
+            switch $col {
+                "#1" {
+                    set couple "$new_label $vars"
+                }
+                "#2" {
+                    set couple "$component $new_label"
+                }
+            }
+        }
+        lappend newcontent $couple
+    }
+    
+    cluster_content_to_variable $address $newcontent
+    eval $widgetInfo($address-check)
+}
+
+
+
+
+proc cluster_refresh {win address} {
+    global widgetInfo XMLtree
+    # Reinitialize the treeview
+    
+    if {$widgetInfo($address-clustermode) =="require"} {
+        cluster_require $win $address
+    }
+}
+
+
+proc cluster_refreshStatus {win address} {
+    global widgetInfo XMLtree
+    # Reinitialize the treeview
+    
+  
+    
+    
+    $win.ftv.tv delete [$win.ftv.tv children {}]
+    
+    set compolenght 0
+    # create the lines of the treeview
+    set widgetInfo($address-status_txt) ""
+    set widgetInfo($address-status) 1
+    
+    set full_address_XML [split $address "."]
+    set full_type [dTree_getAttribute $XMLtree $full_address_XML "type"]
+    set type [string range $full_type  5 end ]
+    
+    set sum 0    
+    
+    foreach couple [cluster_variable_to_content $address]  {
+        set component [lindex  $couple 0]
+        set var [lrange  $couple 1 end]
+
+        set cl [string length $component]
+        if {$cl>$compolenght} {set compolenght $cl}
+             
+        set test_label [test_vartype $component $widgetInfo($address-labelstype) ]       
+        set test_cluster [test_vartype $var $type ]
+        if { $test_cluster == 1 && $test_label == 1} {
+            $win.ftv.tv insert {} end -id $component -text "$component" -image "" -tags "true"
+        } else {
+            
+            if { $test_cluster != 1} {
+                 set widgetInfo($address-status_txt) $test_cluster
+            }
+           
+            if { $test_label != 1} {
+                 set widgetInfo($address-status_txt) $test_label
+            }
+            
+            set widgetInfo($address-status) -1
+            $win.ftv.tv insert {} end -id $component -text "$component" -image "" -tags "false"
+        }
+        
+        if {$type == "fraction" && [string is double $var]} {
+            set sum [expr {$sum + $var}] 
+        }
+    
+        
+        $win.ftv.tv set $component #1 "$component"
+        $win.ftv.tv set $component #2 $var
+    }
+    
+    if {$type == "fraction"} {
+        if {$sum != 1.0 } {
+            set test_cluster "sum fractions not one"
+            set widgetInfo($address-status_txt) $test_cluster
+            set widgetInfo($address-status) -1
+        }
+    }
+    
+    
+    $win.ftv.tv tag configure false -background #ff5050
+    $win.ftv.tv tag configure unknown -background #ffcd7c
+    $win.ftv.tv tag configure true -background ""
+    
+    set colwidth1 [expr {int([expr {0.5* $widgetInfo(guiSmallWidgetWidth)  *$widgetInfo($address-ratio)  }])}]
+    set colwidth2 [expr {int([expr {0.5* $widgetInfo(guiSmallWidgetWidth)}]) - $colwidth1}]
+    $win.ftv.tv column #1 -width $colwidth1 -anchor w
+    $win.ftv.tv column #2 -width $colwidth2 -anchor w
+    
+    
+    set nrows  [llength [cluster_variable_to_content $address] ]
+    
+    $win.ftv.tv configure -height $nrows
+    
+    if { $widgetInfo($address-status) == -1 } { 
+       $win.ftv.status configure -image icon_flag
+    } else {
+        $win.ftv.status configure -image ""
+    }
+    smartpacker_update_visibility $win $address
+    
+    
+}
+
+
+
+
+
+
+proc cluster_content_to_variable {address content} {
+    global widgetInfo
+    set buffer ""
+    foreach couple $content {
+        lappend buffer [lindex  $couple 0]
+        lappend buffer [lrange  $couple 1 end]
+    }
+    set widgetInfo($address-variable) [join $buffer ";" ]
+}
+
+
+proc cluster_variable_to_content {address} {
+    global widgetInfo
+    set couple ""
+    set content ""
+    foreach item [split $widgetInfo($address-variable)  ";" ] {
+        set couple "$couple $item"
+        if {[llength $couple] == 2 } {
+            lappend content $couple
+            set couple ""
+        }
+    }
+    return $content
+}
+
+proc cluster_component_list {address} {
+    global widgetInfo
+    set list_component ""
+    foreach couple [cluster_variable_to_content $address] {
+        set component [lindex $couple 0]
+        lappend list_component $component
+    }
+    return $list_component
+}
+
+proc cluster_var_list {address} {
+    global widgetInfo
+    set list_vars ""
+    foreach couple [cluster_variable_to_content $address] {
+        set vars [lrange  $couple 1 end]
+        lappend list_vars $vars
+    }
+    return $list_vars
+}
+
+
+
+
+
+
+# prepare the filling in a different manner if a require is waiting
+proc cluster_require { win address } {
+    global widgetInfo
+    set reqVar $widgetInfo($address-requiredValue) 
+    set default [lindex [split $widgetInfo($address-default) ";"]  1]
+    if {$default==""} {set default 0 }
+    set old_content [cluster_variable_to_content $address]
+    set new_content ""       
+    # get the present values of the components if they belong to reQvar   
+    foreach actual_component $reqVar {
+        set component_found 0
+        foreach couple $old_content {
+            set component [lindex $couple 0]
+            set var [lrange  $couple 1 end]
+            if {$component == $actual_component} {
+                lappend new_content "$component $var"
+                set component_found 1
+            }
+        }
+        if {$component_found==0 } {lappend new_content "$actual_component $default"}
+    }
+    
+    
+    
+    if {$new_content != $old_content} {
+       cluster_content_to_variable $address $new_content
+    } 
+    
+    # hide if void list
+    if {[llength $new_content] == 0} {
+        pack forget $win
+        return
+    } else {
+        eval $widgetInfo(packme-$win)
+    }
+    return
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comment.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comment.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comment.tcl	(revision 4775)
@@ -0,0 +1,207 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+# COMMENT CREATION
+
+proc comment_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    
+    
+    # Initializes the widget
+    initWidget  
+    
+    set widgetInfo($address-status) 1
+    
+    ttk::frame $win 
+    eval $widgetInfo(packme-$win)
+   
+
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]   
+    ttk::label $win.lb -text "$title:" 
+    ttk::frame $win.t 
+    
+    pack $win.lb -side top -pady 3
+    pack $win.t -side top -pady {0 5}
+    
+    set size_v 5
+    set size_h 40
+    set widgetInfo($address-cleanstring) [dTree_tryGetAttribute $XMLtree  $full_address_XML_clean "cleanstring" "on"] 
+    
+    set size [split [dTree_tryGetAttribute $XMLtree  $full_address_XML_clean "size" "1;1"] ";"]
+    if {[llength $size] != 2 } {puts "Error, size attribute in comment should be formatted as size=x;y"}    
+    set size_h [expr {int([lindex $size 0]*1.*$size_h)}]
+    set size_v [expr {int([lindex $size 1]*1.*$size_v)}]
+    
+    
+    set widgetInfo($address-state)  [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "state" "normal"]
+    
+    switch $widgetInfo($address-state) {
+        "normal" {
+            text $win.t.text  -yscrollcommand [list $win.t.sby set]  -width $size_h -height $size_v -wrap word -background khaki1 -highlightcolor black -highlightbackground [ThemeColor 0.9] -selectbackground skyblue1 -highlightthickness 1
+            label $win.t.text.corner -image icon_corner -compound left -background khaki1 -borderwidth 0
+            place $win.t.text.corner -relx 1.0 -rely 1.0 -anchor se
+        }
+        "disabled" {
+            text $win.t.text  -yscrollcommand [list $win.t.sby set]  -width $size_h -height $size_v -wrap word -state disabled -background [ThemeColor 1]  -highlightcolor black -highlightbackground black -selectbackground skyblue1 -highlightthickness 1
+        }
+    }
+    
+    bind  $win.t.text <Enter> [subst { set tabscroll 0 }]
+    bind  $win.t.text <Leave> [subst { set tabscroll 1 }]
+   
+    
+    bind $win.t.text <FocusOut>  [subst {eval \$widgetInfo($address-check)}]
+    ttk::scrollbar $win.t.sby -orient vertical -command [list $win.t.text yview]
+    
+    grid $win.t.text -row 1 -column 0 -sticky nes 
+    grid $win.t.sby -row 1 -column 1 -sticky news
+    
+    if {$widgetInfo($address-cleanstring) == "latex"} {
+        ttk::frame $win.t.latex
+        grid $win.t.latex -row 2 -column 0 -sticky news -pady 2
+        
+        ttk::button $win.t.latex.bold -text "Bold" -width 4  -command [subst {
+            comment_decoration $win $address "BSLASHtextbf{" "}"
+        }]
+        pack  $win.t.latex.bold -side left 
+        
+        ttk::button $win.t.latex.ital -text "Ital." -width 4  -command [subst {
+            comment_decoration $win $address "BSLASHtextit{" "}"
+        }]
+        pack  $win.t.latex.ital -side left 
+        
+        ttk::button $win.t.latex.item -text "Item." -width 4  -command [subst {
+            comment_decoration $win $address "BREAKLINE BSLASHbegin{itemize} BREAKLINE BSLASHitem " "BREAKLINE BSLASHend{itemize} BREAKLINE"
+        }]
+        pack  $win.t.latex.item -side left 
+        ttk::button $win.t.latex.enum -text "Enum." -width 4  -command [subst {
+            comment_decoration $win $address "BREAKLINE BSLASHbegin{enumerate} BREAKLINE BSLASHitem " "BREAKLINE BSLASHend{enumerate} BREAKLINE"
+        }]
+        pack  $win.t.latex.enum -side left 
+        
+        
+        ttk::button $win.t.latex.circum -text "^" -width 1  -command [subst {
+            comment_decoration $win $address "BSLASH^{" "}"
+        }]
+        pack  $win.t.latex.circum -side left -padx {2 0}
+        
+        ttk::button $win.t.latex.trema -text "Âš" -width 1  -command [subst {
+            comment_decoration $win $address "BSLASHÂš{" "}"
+        }]
+        pack  $win.t.latex.trema -side left
+        
+        
+        
+        
+        bind $win.t.text <<Selection>>  [subst {
+            set sel \[$win.t.text tag ranges "sel"\]
+            if {\$sel != ""} {
+                set widgetInfo($address-selection) \$sel    
+            }
+            log ">>  \$widgetInfo($address-selection)"
+        }]
+    }
+    
+    
+    #add the check/refresh procedure to the bindings of the variable
+   
+    append widgetInfo($address-refresh) [subst { comment_refresh $win $address}]
+    append widgetInfo($address-check) [subst { comment_check $win $address}]
+    finishWidget
+    
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc comment_decoration {win address prefix suffix} {
+    global widgetInfo
+    set i0 [lindex $widgetInfo($address-selection) 0]
+    set i1 [lindex $widgetInfo($address-selection) 1]
+    
+    set txt [$win.t.text get $i0 $i1]
+    
+    set bit [string map {"BSLASH" "\\" "BREAKLINE" "\n"} "$prefix$txt$suffix"]
+    $win.t.text replace  $i0 $i1 $bit
+
+}
+
+proc comment_refresh {win address} {
+    global widgetInfo
+    
+    $win.t.text configure -state normal
+    $win.t.text delete 0.0 end
+    set txt [string map {"BREAKLINE" "\n"  "&gt;" "/" "&quot;" "'" "&amp;" "&"}  $widgetInfo($address-variable)  ]
+    $win.t.text insert end $txt
+    $win.t.text configure -state $widgetInfo($address-state)
+    
+    smartpacker_update_visibility $win $address
+}
+
+
+proc comment_check {win address} {
+    global widgetInfo
+    set txt [string trim [$win.t.text get 0.0 end]]
+    
+    
+    switch $widgetInfo($address-cleanstring) {
+        "latex" {   set txt [ string2latex $txt ] }
+        "on" {   set txt [ stringclean $txt ] }
+        "off" {}
+        default {}
+    }
+    
+    
+   
+   #enleve les accents dans l'affichage
+    $win.t.text configure -state normal
+    $win.t.text delete 0.0 end
+    $win.t.text insert end $txt
+    
+    $win.t.text configure -state $widgetInfo($address-state)
+    
+    # stocke dans la variable
+    set txt [string map {\n BREAKLINE}  $txt  ]
+    
+    set widgetInfo($address-variable) $txt
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comparator.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comparator.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_comparator.tcl	(revision 4775)
@@ -0,0 +1,405 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# COMPARATOR CREATION
+
+proc comparator_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    set widgetInfo($address-status) 0
+    set widgetInfo($address-boxsize) 15
+    set widgetInfo($address-statustxt) ""
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]   
+    set widgetInfo($address-folder)  [dTree_getAttribute $XMLtree $full_address_XML "folder"]
+    ttk::labelframe $win -text "$title" 
+    eval $widgetInfo(packme-$win)
+   
+    
+    #ttk::label $win.lb -text "$title" 
+    #grid $win.lb -column 0 -row 0 -sticky news
+    
+    
+    #frame for picker
+    ttk::frame $win.t 
+    
+  
+    
+    # size of widget
+    set size_v [expr 0.3*$widgetInfo(guiBigWidgetWidth)]
+    set size_h [expr 0.3*$widgetInfo(guiBigWidgetWidth)]
+    canvas $win.t.can -background [ThemeColor 1.0]  -highlightthickness 1 -highlightbackground [ThemeColor 0.5] -yscrollcommand [list $win.t.sby set] -xscrollcommand [list $win.t.sbx set]   -width $size_h -height $size_v 
+    ttk::scrollbar $win.t.sby -orient vertical -command [list $win.t.can yview]
+    ttk::scrollbar $win.t.sbx -orient horizontal -command [list $win.t.can xview]
+    grid $win.t.can -row 1 -column 0 -sticky news 
+    
+    
+    
+    # frame for graphs   
+    ttk::frame $win.gr
+    #pack $win.gr -side top -pady {0 5}
+    
+    set size_v [expr 0.3*$widgetInfo(guiBigWidgetWidth)]
+    set size_h [expr 0.8*$widgetInfo(guiBigWidgetWidth)]    
+    canvas $win.gr.can  -background [ThemeColor 1.0]  -highlightthickness 1 -highlightbackground [ThemeColor 0.5] -yscrollcommand [list $win.gr.sby set] -xscrollcommand [list $win.gr.sbx set]   -width $size_h -height $size_v
+    ttk::scrollbar $win.gr.sby -orient vertical -command [list $win.gr.can yview]
+    ttk::scrollbar $win.gr.sbx -orient horizontal -command [list $win.gr.can xview]
+    
+    ttk::frame $win.gr.c
+    ttk::button $win.gr.c.zoomplus -image icon_magnifierplus -command [subst {grapher_zoom $win.gr.can  1.1}]
+    ttk::button $win.gr.c.zoomminus -image icon_magnifierminus -command [subst {grapher_zoom $win.gr.can  0.9}]
+    ttk::button $win.gr.c.dump -text "Dump" -command [subst {comparator_dump $win $address }]
+    ttk::label $win.gr.c.statustxt -textvariable widgetInfo($address-statustxt) -compound left
+    pack $win.gr.c.zoomplus -side left 
+    pack $win.gr.c.zoomminus -side left
+    pack $win.gr.c.dump -side left
+    pack $win.gr.c.statustxt -side left
+    
+    
+    
+    grid $win.gr.can -row 1 -column 0 -sticky news 
+    #grid $win.gr.sby -row 1 -column 1 -sticky ns
+    #grid $win.gr.sbx -row 2 -column 0 -sticky ew
+    grid $win.gr.c -row 3 -column 0 -sticky ew
+    
+  
+    
+     # frame for treeview   
+    ttk::frame $win.tv
+
+    
+    ttk::treeview $win.tv.tv  -yscrollcommand [list $win.tv.sby set] -columns "lvalue rvalue" -height 8
+    $win.tv.tv column #0 -width [expr {int(0.3*$widgetInfo(guiBigWidgetWidth))}]
+    $win.tv.tv column 0 -width [expr {int(0.4*$widgetInfo(guiBigWidgetWidth))}]
+    $win.tv.tv column 1 -width [expr {int(0.4*$widgetInfo(guiBigWidgetWidth))}]
+    
+    
+    #$win.tv.tv insert {} 0 -id "dataset" -text "." -open "true"
+    
+    ttk::scrollbar $win.tv.sby -orient vertical -command [list $win.tv.tv yview]
+   
+   
+   
+    
+    grid $win.tv.tv -row 1 -column 0 -sticky news 
+    grid $win.tv.sby -row 1 -column 1 -sticky ns
+ 
+
+    
+    grid $win.t  -column 0 -row 0 -sticky news
+    grid $win.gr -column 1 -row 0  -sticky news
+    grid $win.tv -column 0 -row 1 -sticky news -columnspan 2
+    
+    
+    
+    #add the check/refresh procedure to the bindings of the variable
+    append widgetInfo($address-refresh) [ subst { comparator_refresh $win $address}]
+    append widgetInfo($address-check) [subst { comparator_check $win $address}]
+    
+    finishWidget
+    
+    #trick?
+    #bind $win.t.can <ButtonPress-1> {+; focus %W}
+    bind $win.t.can <Motion> [subst {comparator_showlocation $win  $address}]   
+    #  scroll
+    bind $win.t.can   <ButtonPress> [subst {$win.t.can scan mark %x %y}]
+    bind $win.t.can   <B1-Motion> [subst {$win.t.can scan dragto %x %y 1}]
+    
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+proc comparator_refresh {win address} {
+    global widgetInfo
+    comparator_update $win $address
+}
+
+proc comparator_update {win address} {
+    global widgetInfo
+    
+    $win.t.can delete all
+    
+    set list_runs  $widgetInfo($address-requiredValue) 
+
+    # remove selected comparisons from the variable if this run is no more available
+    set current_variable [split $widgetInfo($address-variable) ";"]
+    foreach selectedpair $current_variable {
+        set run1 [lindex [split $selectedpair "@"] 0]
+        set run2 [lindex [split $selectedpair "@"] 1]
+        if {[lsearch $list_runs $run1 ] == -1 } {
+            set current_variable [lremove current_variable $selectedpair]
+        } elseif {[lsearch $list_runs $run2 ]==-1} {
+            set current_variable [lremove current_variable $selectedpair]
+        }
+    }
+    
+    set boxsize $widgetInfo($address-boxsize)
+    
+    #title up
+    set col 0
+    foreach run $list_runs {
+        set title_x [expr { $boxsize*(0.5+$col)}]
+        set title_y [expr { $boxsize*(-0.0)}]
+        set run_sim [lindex [split $run "#"] 0]
+        set run_proj [lindex [split $run "#"] 1]
+        set run_run [lindex [split $run "#"] 2]
+        canvas_text_vector $win.t.can  $title_x $title_y "$run_proj $run_run" sw 8 -45 [comparator_getcolor $run_sim] titleup
+        incr col
+    }
+    #title left
+    set col 0
+    foreach run $list_runs {
+        set title_x [expr { $boxsize*(-0.2+$col)}]
+        set title_y [expr { $boxsize*(0.2+$col)}]
+        set run_sim [lindex [split $run "#"] 0]
+        set run_proj [lindex [split $run "#"] 1]
+        set run_run [lindex [split $run "#"] 2]
+        canvas_text_vector $win.t.can $title_x $title_y "$run_proj $run_run" nw 8 0 [comparator_getcolor $run_sim] titleup
+        incr col
+    }
+    
+    set row 0
+    set col 0
+    foreach run1 $list_runs {
+        foreach run2 $list_runs {
+            set run1_sim [lindex [split $run1 "#"] 0]
+            set run2_sim [lindex [split $run2 "#"] 0]
+            set run1_proj [lindex [split $run1 "#"] 1]
+            set run2_proj [lindex [split $run2 "#"] 1]
+            set run1_run [lindex [split $run1 "#"] 2]
+            set run2_run [lindex [split $run2 "#"] 2]
+            if  {$col >= $row} {
+                 if {$col == $row } {
+                    set shade 0.0
+                 } elseif {$run1_sim == $run2_sim} {
+                    set shade 0.5
+                 } else {
+                    set shade 0.75
+                 }
+                 
+                set couple "$run1@$run2"
+                # ul_x--------------
+                # ul_y             |
+                # |                |
+                # |  ul2_x---|     |
+                # |  ul2_Y   |     |
+                # |  |       |     |
+                # |  |      lr2_x  |
+                # |  |------lr2_y  |
+                # |                |
+                # |                |
+                # |             lr_x
+                # |-------------lr_y
+                set ul_x [expr {$col*$boxsize}]
+                set ul_y [expr {$row*$boxsize}]
+    
+                set lr_x [expr {$ul_x+$boxsize}]
+                set lr_y [expr {$ul_y+$boxsize}]
+                
+                set ul2_x [expr {($col+0.2)*$boxsize}]
+                set ul2_y [expr {($row+0.2)*$boxsize}]
+    
+                set lr2_x [expr {$ul_x+0.8*$boxsize}]
+                set lr2_y [expr {$ul_y+0.8*$boxsize}]
+                
+                $win.t.can create polygon $ul_x $ul_y $ul_x $lr_y $lr_x $lr_y $ul_x $ul_y -fill [shadeColor [comparator_getcolor $run1_sim] $shade] -tags "$couple"
+                $win.t.can create polygon $ul_x $ul_y $lr_x $ul_y $lr_x $lr_y $ul_x $ul_y -fill [shadeColor [comparator_getcolor $run2_sim] $shade] -tags "$couple"
+                $win.t.can create line $ul_x $ul_y $lr_x $ul_y $lr_x $lr_y $ul_x $lr_y  $ul_x $ul_y -fill black
+                
+                if {[lsearch $current_variable $couple] != -1} {
+                    $win.t.can create oval $ul2_x $ul2_y  $lr2_x $lr2_y  -outline white -width 2 -tags "$couple"
+                }
+                $win.t.can bind $couple <ButtonPress> [subst {comparator_clickrun $win $address $couple}]
+            }
+            incr col
+        }
+        set col 0
+        incr row
+    }
+    
+    set widgetInfo($address-status) 0
+    set widgetInfo($address-statustxt) "Comparisons data need to be dumped..."
+    $win.gr.c.statustxt configure -image icon_question
+    
+    $win.t.can configure -scrollregion [ $win.t.can bbox all]
+    
+    smartpacker_update_visibility $win $address
+    
+    
+    set widgetInfo($address-variable) [join $current_variable ";"]
+}
+
+proc comparator_clickrun {win address selectedpair} {
+    global widgetInfo
+    
+    
+    set current_variable [split $widgetInfo($address-variable) ";"]
+    $win.gr.can delete all
+    if {[lsearch $current_variable $selectedpair] != -1 } {
+        # remove a comparison
+        set current_variable [lremove current_variable $selectedpair]
+        set file1   [ lindex [ split $selectedpair "@"] 0 ]
+        set file2   [ lindex [ split $selectedpair "@"] 1 ] 
+        #debug "Removes $file1 $file2"
+        
+        #$win.tx.txt configure -state normal
+        #$win.tx.txt delete 0.0 end
+        #$win.tx.txt configure -state disabled
+        
+        
+    } else {
+        # add a comparison
+        lappend current_variable $selectedpair
+        set file1  [ lindex [ split $selectedpair "@"] 0 ] 
+        set file2  [ lindex [ split $selectedpair "@"] 1 ] 
+        grapher_create $win $address $win.gr.can $win.tv.tv [file join {*}$widgetInfo($address-folder)] "$file1" "$file2" 0
+        #debug "Add  $file1 $file2"
+    }
+    
+    set widgetInfo($address-variable) [join $current_variable ";"]
+    
+    comparator_update $win $address
+    
+    eval $widgetInfo($address-check)
+    return
+}
+
+
+proc comparator_getcolor {sim} {
+    set color "black"
+    switch $sim {
+        "Sim.1" {
+            set color "black"
+        }
+        "Sim.2" {
+            set color "red"
+        }
+        "Sim.3" {
+            set color "blue"
+        }
+        "Sim.4" {
+            set color "green4"
+        }  
+    }
+    return $color
+
+}
+
+proc comparator_dump {win address} {
+    global widgetInfo
+    set current_variable [split $widgetInfo($address-variable) ";"]
+    
+    #cleaning
+    foreach filename [glob -nocomplain [file join {*}$widgetInfo($address-folder) *.gif] ] {
+        file delete -force $filename
+    }
+    foreach filename [glob -nocomplain [file join {*}$widgetInfo($address-folder) *.html] ] {
+        file delete -force $filename
+    }
+    foreach filename [glob -nocomplain [file join {*}$widgetInfo($address-folder) *.txt] ] {
+        file delete -force $filename
+    }
+    
+    # saving comparisons
+    set index 1
+    set items [llength $current_variable]
+    foreach selectedpair $current_variable {
+        set widgetInfo($address-statustxt) "Dumping $index/$items..."
+        update idletasks
+        
+        set file1 [join [ split [ lindex [ split $selectedpair "@"] 0 ] "#" ] "_"]
+        set file2 [join [ split [ lindex [ split $selectedpair "@"] 1 ] "#" ] "_"]
+        grapher_create $win $address $win.gr.can $win.tv.tv [file join {*}$widgetInfo($address-folder)] "$file1" "$file2" 1
+        incr index
+    }
+    
+    # saving selection
+    set widgetInfo($address-statustxt) "Dumping Selection Array..."
+    update idletasks
+    canvas_makegif $win.t.can  [file join {*}$widgetInfo($address-folder) "$widgetInfo($address-name).gif"]
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-statustxt) "Comparisons data are saved!"
+    $win.gr.c.statustxt configure -image icon_ok
+}
+
+proc comparator_showlocation {win address} {
+    global widgetInfo
+    $win.t.can delete "pointer"   
+    set x [$win.t.can canvasx [expr {[winfo pointerx $win.t.can] - [winfo rootx $win.t.can]}]]
+    set y [$win.t.can canvasy [expr {[winfo pointery $win.t.can] - [winfo rooty $win.t.can]}]]
+    
+    if {$x < 0} {return}
+    if {$y < 0} {return}
+    
+    set boxsize $widgetInfo($address-boxsize)
+    set col [expr {int($x*1.0/$boxsize)}]
+    set row [expr {int($y*1.0/$boxsize)}]
+    
+    set maxcol [expr {[llength $widgetInfo($address-requiredValue) ]-1}]
+    
+    if {$col < $row} {return}
+    if {$col > $maxcol} {return}
+    if {$row > $maxcol} {return}
+    
+    set runcol [lindex $widgetInfo($address-requiredValue) $col]
+    set runrow [lindex $widgetInfo($address-requiredValue) $row]  
+    if {$col == $row} {
+        set widgetInfo($address-position) "$runcol"
+    } else {
+        set widgetInfo($address-position) "$runrow \n .vs. \n $runcol "
+    }
+    canvas_text_highlighted $win.t.can $x $y  $widgetInfo($address-position) "pointer" 
+}
+
+
+
+proc comparator_check {win address} {
+    global widgetInfo
+    
+    #canvas_makegif $win.t.can $address "$widgetInfo($address-name).gif"
+    
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_dynlist.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_dynlist.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_dynlist.tcl	(revision 4775)
@@ -0,0 +1,316 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc dynlist_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    initWidget
+    
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    set widgetInfo($address-type) [dTree_getAttribute $XMLtree $full_address_XML "type"]
+    set widgetInfo($address-renaming) 0
+    set widgetInfo($address-status) 1
+    ttk::frame $win
+    
+    #title
+    ttk::label $win.title  -text $title
+
+    # listbox and scrollbar
+    ttk::frame $win.dl
+    listbox $win.dl.lb -listvariable widgetInfo($address-content) -yscrollcommand [list $win.dl.sby set] -height 5 -activestyle none 
+    $win.dl.lb  selection set 0
+    # avoid tab scrolling for mousewheel
+    bind $win.dl.lb <MouseWheel> {+set tabscroll 0}
+    bind $win.dl.lb <Leave> {+set tabscroll 1}
+    
+    
+    
+    
+    ttk::scrollbar $win.dl.sby -orient vertical -command [list $win.dl.lb yview]
+    # avoid tab scrolling for mousewheel
+    bind $win.dl.sby <MouseWheel> {+set tabscroll 0}
+    bind $win.dl.sby <Leave> {+set tabscroll 1}
+    
+    grid $win.dl.lb -sticky news -column 0 -row 0
+    grid $win.dl.sby -sticky news -column 1 -row 0
+    
+    # controls
+    ttk::frame $win.controls
+    ttk::label $win.controls.add -width 1 -image icon_plus -relief raised
+    ttk::label $win.controls.rm  -width 1 -image icon_minus -relief raised
+    pack $win.controls.add $win.controls.rm  -side left -anchor nw -padx 0 -pady 0
+    
+    #status
+    ttk::label $win.status -textvariable widgetInfo($address-status_txt) -foreground  red
+    
+    #packing
+    pack $win -pady 5
+    pack $win.status -side bottom -anchor nw
+    pack $win.title -side top -anchor nw
+    pack $win.dl -anchor nw
+    pack $win.controls -anchor nw
+
+    # bindings
+    
+    # kill rename dialog if leaving widget
+    bind $win <Leave> +[subst {
+        destroy $win.dl.lb.rename
+        set widgetInfo($address-renaming) 0
+    }]
+        
+    
+    #double click
+    bind $win.dl.lb <Double-1> [subst { dynlist_rename_existing $win $address %y }]
+    #simple click
+    bind $win.dl.lb <ButtonPress> [subst {+
+        # cancel renaming if necessary
+        if { \$widgetInfo($address-renaming) != 0 } {
+            destroy $win.dl.lb.rename
+            set widgetInfo($address-renaming) 0
+        }    
+    }]
+    
+    # addition
+    bind $win.controls.add  <ButtonPress> [subst {
+        $win.controls.add configure -relief sunken
+        dynlist_add $win $address 
+    }]
+    
+    bind $win.controls.add  <ButtonRelease> [subst {$win.controls.add configure -relief raised}]
+    
+    
+    # deletion
+    bind $win.controls.rm  <ButtonPress> [subst {
+        $win.controls.rm configure -relief sunken
+        dynlist_del $win $address 
+        
+    }]
+    bind $win.controls.rm  <ButtonRelease> [subst {$win.controls.rm configure -relief raised}]
+    
+    
+    append widgetInfo($address-refresh) [subst { dynlist_refresh $win $address }]
+    append widgetInfo($address-check) [ subst { dynlist_check $win $address }]
+    finishWidget
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+# after variable> tmpTree
+proc dynlist_check {win address} {
+    global widgetInfo
+#    set type [lindex [ split $widgetInfo($address-type) "_" ] 1 ]
+#    set test_dl 1
+#    foreach elt $widgetInfo($address-content) {
+#        set test_dl [expr {[ test_vartype $elt $type ] * $test_dl}]
+#    }
+#    
+#    if {$test_dl == 1} {
+#        set widgetInfo($address-status) 1
+#        set widgetInfo($address-status_txt) ""
+#        #set widgetInfo($address-content) [lreplace $widgetInfo($address-content) $index $index $widgetInfo($address-entry)]
+#    } else {  
+#        set widgetInfo($address-status) -1
+#        set widgetInfo($address-status_txt) $test_dl
+#    }
+    
+    set widgetInfo($address-variable) [join $widgetInfo($address-content) ";"]
+}
+
+# after DStree >variable
+proc dynlist_refresh {win address} {
+    global widgetInfo
+    set widgetInfo($address-content) [split $widgetInfo($address-variable) ";"]
+}
+
+
+
+# DYNLIST specific procedures
+
+# addition of one element to the list
+proc dynlist_add {win address} {
+    global widgetInfo tmpTree
+    
+    # cancel renaming if on
+    if { $widgetInfo($address-renaming) != 0} {
+        destroy $win.dl.lb.rename
+        set widgetInfo($address-renaming) 0
+    }    
+    
+    # get where to insert the item
+    set rank [$win.dl.lb curselection]
+    if {$rank ==""} {
+        set rank end
+    } else {
+        incr rank
+    }
+    
+    
+    # find what to insert
+    set type [lindex [ split $widgetInfo($address-type) "_" ] 1 ]
+    switch $type {
+        "double" {
+            set guess "0.0"
+            while {[lsearch "$widgetInfo($address-content)" "$guess"] != -1} {
+                set guess [expr (guess+1.0)]
+            }
+        }
+        "integer" {
+            set guess "0"
+            while {[lsearch "$widgetInfo($address-content)" "$guess"] != -1} {
+                incr guess
+            }
+        }
+        default {
+            set guess "0"
+            while {[lsearch "$widgetInfo($address-content)" "item_$guess"] != -1} {
+                incr guess
+            }
+            set guess "item_$guess"
+        }
+    }
+    
+    set widgetInfo($address-content) [linsert $widgetInfo($address-content) $rank $guess]
+    
+    #call rename dialog
+    dynlist_rename $win $address $rank
+    
+    eval $widgetInfo($address-check)
+   
+}
+
+
+# renaming an element in the list
+proc dynlist_rename_existing {win address y} {
+    global widgetInfo tmpTree
+    dynlist_rename $win $address [$win.dl.lb nearest $y]  
+    eval $widgetInfo($address-check)
+}
+
+
+# renaming dialog
+proc dynlist_rename {win address rank } {
+    global widgetInfo
+    
+    if { $widgetInfo($address-renaming) != 0 } {
+        focus $win.dl.lb.rename.entry
+        return    
+    }
+    
+    set widgetInfo($address-renaming) $rank
+    
+    $win.dl.lb see $rank
+    set bbox [$win.dl.lb bbox $rank]
+    set width [expr ([winfo width $win.dl.lb]-3)]
+    
+    
+    frame $win.dl.lb.rename -background [ThemeColor 1.]
+    place $win.dl.lb.rename -x [lindex $bbox 0] -y [lindex $bbox 1] -width $width -height [lindex $bbox 3]
+    set widgetInfo($address-entry) [$win.dl.lb get $rank]
+    ttk::entry $win.dl.lb.rename.entry -textvariable widgetInfo($address-entry) 
+    pack $win.dl.lb.rename.entry -expand 1 -fill both
+    $win.dl.lb.rename.entry selection range 0 end
+    $win.dl.lb.rename.entry icursor end  
+    focus $win.dl.lb.rename.entry
+     
+    bind $win.dl.lb.rename.entry <Return>  [ subst {
+        dynlist_setvar $win $address $rank
+        destroy $win.dl.lb.rename
+        set widgetInfo($address-renaming) 0
+    }]
+     
+    bind $win.dl.lb.rename.entry <Escape>  [ subst {
+        destroy $win.dl.lb.rename
+        set widgetInfo($address-renaming) 0
+    }]
+
+}
+
+# insertion of the new item in the list
+proc dynlist_setvar {win address index} {
+    global widgetInfo tmpTree
+    set type [lindex [ split $widgetInfo($address-type) "_" ] 1 ]
+    
+    set test_dl [ test_vartype $widgetInfo($address-entry) $type ] 
+    if {$test_dl == 1} {
+        set widgetInfo($address-status) 1
+        set widgetInfo($address-status_txt) ""        
+        set widgetInfo($address-content) [lreplace $widgetInfo($address-content) $index $index $widgetInfo($address-entry)]
+    } else {  
+        set widgetInfo($address-status) -1
+        set widgetInfo($address-status_txt) $test_dl
+    }
+    eval $widgetInfo($address-check)
+}
+
+
+proc dynlist_del {win address} {
+    global widgetInfo tmpTree
+    
+    # cancel renaming if on
+    if { $widgetInfo($address-renaming) != 0 } {
+        destroy $win.dl.lb.rename
+        $win.dl.lb selection set $widgetInfo($address-renaming)
+        set widgetInfo($address-renaming) 0
+    }    
+     # get where to delete the item
+    set rank [$win.dl.lb curselection]
+    if {$rank ==""} {return}
+    
+    # remove if it is not the last element
+    if {[llength $widgetInfo($address-content)] > 1} {
+         set widgetInfo($address-content) [lreplace $widgetInfo($address-content) $rank $rank ]
+         incr rank -1
+         focus $win.dl.lb
+         $win.dl.lb see $rank
+         $win.dl.lb selection clear 0 end          
+         $win.dl.lb selection set $rank    
+    }
+    
+    eval $widgetInfo($address-check)
+}
+
+
+proc dynlist_update_entry {win address} {
+    global widgetInfo tmpTree
+        set widgetInfo($address-entry) [  $win.dl.lb get [ $win.dl.lb curselection]]
+        eval $widgetInfo($address-check)
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_emptyNode.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_emptyNode.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_emptyNode.tcl	(revision 4775)
@@ -0,0 +1,49 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc emptyNode_create { args } {
+    set mandatory_arguments { path_father address }
+    initWidget
+    
+    
+    finishWidget
+    
+    set widgetInfo($address-status) 0
+    
+    return $win
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_entry.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_entry.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_entry.tcl	(revision 4775)
@@ -0,0 +1,118 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# ENTRY CREATION
+
+proc entry_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    ttk::frame $win -height 40p
+    
+    eval $widgetInfo(packme-$win)
+
+    smartpacker_setup_label $win $address
+    smartpacker_setup_status $win $address
+    
+    ttk::entry $win.entry -textvariable  widgetInfo($address-variable) 
+    bind $win.entry <KeyRelease>  [subst {eval \$widgetInfo($address-check)}]
+    
+    place $win.entry -relx 0.5 -rely 0. -relwidth $widgetInfo(guiEntryRelWidth)  -anchor nw
+    
+    
+    #add the check/refresh procedure to the bindings of the variable
+   
+    append widgetInfo($address-refreshStatus) [ subst { entry_refreshStatus $win $address}]
+    
+    finishWidget
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc entry_refreshStatus {win address} {
+    global widgetInfo XMLtree
+    
+    smartpacker_update_visibility $win $address
+
+    
+    set full_address_XML [split $address "."]
+    set type [dTree_getAttribute $XMLtree $full_address_XML "type"]
+    
+    
+    switch -glob $type {
+        "*double*" {
+            set widgetInfo($address-variable) [string map {"," "."} $widgetInfo($address-variable)]
+        }
+        "*ascii*" -
+        "*string*" {
+            set widgetInfo($address-variable) [stringclean $widgetInfo($address-variable)]
+        }
+    }
+    
+    
+    set test_entry [test_vartype $widgetInfo($address-variable) $type ]
+    if { $test_entry == 1 } {
+        set widgetInfo($address-status_txt) ""
+        set widgetInfo($address-status) 1
+    } else {
+        set widgetInfo($address-status_txt) $test_entry
+        set widgetInfo($address-status) -1
+    }
+    
+    
+    $win.status configure -image ""
+    
+    if { $widgetInfo($address-variable) == ""} {
+        set widgetInfo($address-status) -1
+        set widgetInfo($address-status_txt) "(...)"
+        $win.status configure -image icon_question
+    }
+     
+    if { $widgetInfo($address-status) == -1 && $widgetInfo($address-status_txt) != "(...)" } { 
+       $win.status configure -image icon_flag
+    } 
+
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_glance.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_glance.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_glance.tcl	(revision 4775)
@@ -0,0 +1,984 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# GLANCE CREATION
+
+proc glance_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    
+    
+    
+    # TACKLE SIZES
+    set size_v [expr { (0.9)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size_h [expr { (0.9)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size [split [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "size" "1;1" ] ";"]
+    set size_h [expr {int([lindex $size 0]*1.*$size_h)}]
+    set size_v [expr {int([lindex $size 1]*1.*$size_v)}]
+    
+    set widgetInfo($address-width) $size_h
+    set widgetInfo($address-height) $size_v
+    set widgetInfo($address-widthcanvas) $size_h
+    set widgetInfo($address-heightcanvas) $size_v
+    
+    set widgetInfo($address-activeselection) ""
+    set widgetInfo($address-selection) ""
+    set widgetInfo($address-dataids) ""
+    set widgetInfo($address-showdiam) 0
+        
+    
+    
+    
+    
+    
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-zoom) "Zoom: 100"
+    
+    set widgetInfo($address-showglance) 0
+    set widgetInfo($address-message) "Hello world!"
+    set widgetInfo($address-rendermessage) ""
+    
+    set widgetInfo($address-dataids) ""
+    
+    
+    set widgetInfo($address-directions) "x y z" 
+    
+    set listproj "{x y} {x z} {z y}"
+    set listcolor "x y z"
+    set listrender "nodes cells"
+    set widgetInfo($address-projection) [lindex $listproj 0]
+    set widgetInfo($address-color) [lindex $listcolor 0]
+    set widgetInfo($address-colormin) 0
+    set widgetInfo($address-colormax) 1
+    set widgetInfo($address-render) [lindex $listrender 0]
+    set widgetInfo($address-clip) [lindex $widgetInfo($address-directions) 0]
+    set widgetInfo($address-clipmin) 0
+    set widgetInfo($address-clipmax) 1
+    
+    
+    ttk::frame $win -relief sunken 
+    eval $widgetInfo(packme-$win)
+
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]   
+    ttk::checkbutton $win.cb -text "$title (on/off)" -variable widgetInfo($address-showglance) -command [subst {glance_show_onoff $win $address}]
+    pack $win.cb -side top -pady 3
+    
+    
+    # fenetre de texte
+    ttk::frame $win.txt -width $size_h
+   
+    
+    ttk::label $win.txt.messagehead -text "Selection"
+    pack $win.txt.messagehead -side top 
+    
+    ttk::separator $win.txt.sep 
+    pack $win.txt.sep -side top -fill x
+    
+    # message label
+    ttk::label $win.txt.message -textvariable widgetInfo($address-message) -wraplength $size_h -width 60
+    pack $win.txt.message -side top -padx 2
+    
+    
+    # fenetre de visu
+    ttk::frame $win.t 
+   
+    # fenetre de controle de vie
+    ttk::frame $win.t.v
+    
+    ttk::button $win.t.v.zoomplus -text "Zoom+" -command [subst { glance_zoom $win $address 2. }]
+    pack $win.t.v.zoomplus -side top
+    ttk::button $win.t.v.zoommin -text "Zoom-" -command [subst { glance_zoom $win $address 0.5  }]
+    pack $win.t.v.zoommin -side top
+    ttk::button $win.t.v.zoomreset -text "Zoom auto" -command [subst { glance_zoom $win $address 1 }]
+    pack $win.t.v.zoomreset -side top
+    ttk::label  $win.t.v.zlbl -textvariable widgetInfo($address-zoom)
+    pack $win.t.v.zlbl -side top
+    ttk::label $win.t.v.mess -textvariable widgetInfo($address-rendermessage)
+    pack $win.t.v.mess -side bottom
+    
+    
+    
+    # GLANCE PART
+    canvas $win.t.can  -yscrollcommand [list $win.t.sby set] -xscrollcommand [list $win.t.sbx set]   -width $size_h -height $size_v 
+    ttk::scrollbar $win.t.sby -orient vertical -command [list $win.t.can yview]
+    ttk::scrollbar $win.t.sbx -orient horizontal -command [list $win.t.can xview]
+    #bind $win.t.can   <ButtonPress> [subst {$win.t.can scan mark %x %y}]
+    #bind $win.t.can   <B1-Motion> [subst {$win.t.can scan dragto %x %y 1}]
+    # render label
+    
+    
+    
+    grid $win.t.v -row 1 -column 0 -sticky news 
+    grid $win.t.can -row 1 -column 1 -sticky news 
+    grid $win.t.sby -row 1 -column 2 -sticky ns
+    grid $win.t.sbx -row 2 -column 1 -sticky ew
+    
+    
+    
+    
+    
+    
+    # controls part
+    ttk::frame $win.c
+    
+    
+    # col 1
+    set column 0
+    set row 0
+    # projection
+    ttk::label $win.c.projlabel -text "Projection"
+    grid $win.c.projlabel -column $column -row $row
+    incr row
+    
+    ttk::combobox $win.c.projection -textvariable widgetInfo($address-projection) -values $listproj -state readonly
+    grid $win.c.projection -column $column -row $row
+    incr row
+    bind  $win.c.projection <<ComboboxSelected>> [subst {
+        set widgetInfo($address-zoom) "Zoom: 100"
+        glance_reset_bounds $win $address
+        glance_render $win $address
+    }]
+    
+    
+    # render
+    ttk::label $win.c.rendlabel -text "Render"
+    grid $win.c.rendlabel -column $column -row $row
+    incr row
+    ttk::combobox $win.c.render -textvariable widgetInfo($address-render) -values $listrender -state readonly
+    
+    grid $win.c.render -column $column -row $row
+    incr row
+    bind  $win.c.render <<ComboboxSelected>> [subst {
+        glance_render $win $address
+    }]
+    
+    
+    
+    # col 2
+    set column 1
+    set row 0
+    # color
+    ttk::label $win.c.colorlabel -text "Color"
+    grid $win.c.colorlabel -column $column -row $row
+    incr row
+    ttk::combobox $win.c.color -textvariable widgetInfo($address-color) -values $listcolor -state readonly
+    grid $win.c.color -column $column -row $row
+    incr row
+    bind  $win.c.color <<ComboboxSelected>> [subst {
+        glance_resets $win $address "color"
+        glance_render $win $address
+    }]
+    
+    # colormin
+    ttk::label $win.c.colorminlabel -text "Min"
+    grid $win.c.colorminlabel -column $column -row $row
+    incr row
+    ttk::entry $win.c.colorvmin -textvariable widgetInfo($address-colormin)
+    
+    bind  $win.c.colorvmin <Return> [subst {
+        if {\$widgetInfo($address-colormin) < \$widgetInfo($address-colormax)} {
+            glance_render $win $address
+        } else {
+            warning "Color min must be smaller than color max"
+            set widgetInfo($address-colormin) \$widgetInfo($address-colormax)
+        } 
+    }]
+    
+    grid $win.c.colorvmin -column $column -row $row
+    incr row
+    
+    # colormax
+    ttk::label $win.c.colormaxlabel -text "Max"
+    grid $win.c.colormaxlabel -column $column -row $row
+    incr row
+    ttk::entry $win.c.colorvmax -textvariable widgetInfo($address-colormax)
+    bind  $win.c.colorvmax <Return> [subst {
+        if {\$widgetInfo($address-colormin) < \$widgetInfo($address-colormax)} {
+            glance_render $win $address
+        } else {
+            warning "Color min must be smaller than color max"
+            set widgetInfo($address-colormax) \$widgetInfo($address-colormin)
+        } 
+    }]
+    grid $win.c.colorvmax -column $column -row $row
+    incr row
+    # colorreset
+    ttk::button $win.c.colorreset -text "Color Reset"  -command [ subst { glance_resets $win $address "color"}]
+    grid $win.c.colorreset -column $column -row $row
+    incr row
+    
+    
+    # col 3
+    set column 2
+    set row 0
+    # clip dir 
+    ttk::label $win.c.cliplabel -text "Clip direction"
+    grid $win.c.cliplabel -column $column -row $row
+    incr row
+    ttk::combobox $win.c.clip -textvariable widgetInfo($address-clip) -values "" -state readonly
+    grid $win.c.clip -column $column -row $row
+    incr row
+    bind  $win.c.clip <<ComboboxSelected>> [subst {
+        set widgetInfo($address-zoom) "Zoom: 100"
+        glance_resets $win $address "clip"
+        glance_render $win $address
+    }]
+    
+    # clipmin
+    ttk::label $win.c.clipminlabel -text "Min"
+    grid $win.c.clipminlabel -column $column -row $row
+    incr row
+    ttk::entry $win.c.clipmin -textvariable widgetInfo($address-clipmin)
+    bind  $win.c.clipmin <Return> [subst {
+        if {\$widgetInfo($address-clipmin) < \$widgetInfo($address-clipmax)} {
+            set widgetInfo($address-zoom) "Zoom: 100"
+            glance_render $win $address
+        } else {
+            warning "Clip min must be smaller than clip max"
+            set widgetInfo($address-clipmin) \$widgetInfo($address-clipmax)
+        } 
+    }]
+    grid $win.c.clipmin -column $column -row $row
+    incr row
+    
+    # clipmax
+    ttk::label $win.c.clipmaxlabel -text "Max"
+    grid $win.c.clipmaxlabel -column $column -row $row
+    incr row
+    ttk::entry $win.c.clipmax -textvariable widgetInfo($address-clipmax)
+    bind  $win.c.clipmax <Return> [subst {
+        if {\$widgetInfo($address-clipmin) < \$widgetInfo($address-clipmax)} {
+            set widgetInfo($address-zoom) "Zoom: 100"
+            glance_render $win $address
+        } else {
+            warning "Clip min must be smaller than clip max"
+            set widgetInfo($address-clipmax) \$widgetInfo($address-clipmin)
+        } 
+    }]
+    grid $win.c.clipmax -column $column -row $row
+    incr row
+    
+    # clipreset
+    ttk::button $win.c.clipreset -text "Clip Reset" -command  [ subst {
+        glance_resets $win $address "clip"
+    }]
+    grid $win.c.clipreset -column $column -row $row  
+    incr row
+    
+    
+    
+    
+    
+    
+  
+    
+    
+    
+    
+    #add the check/render procedure to the bindings of the variable
+    append widgetInfo($address-refresh) [ subst { glance_refresh $win $address}]
+    append widgetInfo($address-check) [subst { glance_check $win $address}]
+    finishWidget
+    
+    #trick?
+    bind $win.t.can <ButtonPress-1> {+; focus %W}
+    
+    
+    
+    # ctrl move
+    bind $win.t.can <Control-Motion> [ subst {glance_move $win $address %x %y }]
+    
+    
+    glance_scrollupdate $win $address 1.0 1.0
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc glance_show_onoff {win address} {
+    global widgetInfo
+
+    switch $widgetInfo($address-showglance) {
+        1 {
+            pack $win.c -side bottom -fill x -padx 3 -pady 3
+            pack $win.txt -side right -anchor n -padx 3 -pady 3
+            pack $win.t -padx 3 -pady 3
+        }
+        0 {
+            glance_purge $win $address
+            pack forget $win.txt 
+            pack forget $win.t 
+            pack forget $win.c
+            
+            foreach dataid $widgetInfo($address-dataids) {
+                array unset widgetInfo "$address-$dataid*"
+                lremove widgetInfo($address-dataids) $dataid
+                set  widgetInfo($address-message) "$widgetInfo($address-message) Removing dataset $dataid \n"
+            }
+            
+        }
+    }
+    event generate . <<SetView>>
+    glance_refresh $win $address
+}
+
+
+proc glance_refresh {win address} {
+    global widgetInfo
+    # clean dataids if not in the variable
+    
+    if { $widgetInfo($address-showglance) == 0 } {
+        return
+    }
+    set widgetInfo($address-message) " Refreshing data... \n\n"
+    
+    foreach dataid $widgetInfo($address-dataids) {
+        array unset widgetInfo "$address-$dataid*"
+        lremove widgetInfo($address-dataids) $dataid
+        set  widgetInfo($address-message) "$widgetInfo($address-message) Removing dataset $dataid \n"
+    }
+    
+    set i 0
+    # parse dataids (skip first which is time)
+    foreach item $widgetInfo($address-variable)  {
+        if {$i ==1} {
+            set dataid $item
+        }
+        if {$i ==2} {
+            set filename $item
+            set  widgetInfo($address-message) "$widgetInfo($address-message) Loading dataset $dataid from $filename \n"
+            set duration [glance_parsecontent $win $address $dataid $filename]
+            
+            set  widgetInfo($address-message) "$widgetInfo($address-message) $duration s. \n"
+            set i 1
+        }
+        incr i
+    }
+    
+    
+    
+    # update visualisation
+    glance_reset_bounds $win $address
+    glance_render $win $address
+}
+
+proc glance_render {win address} {
+    set start_time [clock milliseconds]
+    global widgetInfo
+    glance_purge $win $address
+       
+   
+    
+    
+    set xtitle [lindex $widgetInfo($address-projection) 0]
+    set ytitle [lindex $widgetInfo($address-projection) 1]
+    set ctitle $widgetInfo($address-color)
+
+    
+    set rscale [colorscale_define rainbow]
+    
+    
+    
+    foreach dataid $widgetInfo($address-dataids) {
+        foreach part $widgetInfo($address-$dataid-root.children) {
+            set range [llength $widgetInfo($address-$dataid-root.$part.$xtitle)]
+            
+            # prepare data to show
+            set node_components ""
+            set header ""
+            foreach compo $widgetInfo($address-$dataid-root.$part.children) {
+                set lcompo [llength $widgetInfo($address-$dataid-root.$part.$compo)]
+                if {$lcompo == $range} {
+                    lappend node_components $compo
+                }
+                if {$lcompo == 1} {
+                   lappend header "$compo : $widgetInfo($address-$dataid-root.$part.$compo)"
+                }
+            }
+        
+        
+        
+        
+        
+            if {$widgetInfo($address-render) == "cells" && $widgetInfo($address-$dataid-list_conn) != ""} {
+                # show by cells
+                set i 0
+                set color 0
+                set show 1
+                
+                
+                foreach node $widgetInfo($address-$dataid-root.$part.conn) {
+                    
+                    incr i
+                    # clip
+                    set rclip [lindex $widgetInfo($address-$dataid-root.$part.$widgetInfo($address-clip)) $node-1]
+                    if {$rclip >  $widgetInfo($address-clipmax)} {set show 0}
+                    if {$rclip <  $widgetInfo($address-clipmin)} {set show 0}
+                    
+                    # information
+                    if {$show == 1} {
+                        set face(px-$i) [glance_pix_x $address [lindex $widgetInfo($address-$dataid-root.$part.$xtitle) $node-1]]
+                        set face(py-$i) [glance_pix_y $address [lindex $widgetInfo($address-$dataid-root.$part.$ytitle) $node-1]]
+                        if {[info exists widgetInfo($address-$dataid-root.$part.$ctitle)]} {
+                            set col [lindex $widgetInfo($address-$dataid-root.$part.$ctitle)  $node-1]
+                            set col [expr {($col-$widgetInfo($address-colormin))/($widgetInfo($address-colormax)-$widgetInfo($address-colormin))}]
+                            set color [colorscale_get $rscale $col]
+                        } else {
+                            set color black
+                        }
+                        set outline_color $color
+                    }
+                    
+                    
+                    # show triangles
+                    if {$i == 3} {
+                        if {$show == 1} {
+                            # data to show
+                            set details $header
+                            foreach compo $node_components {
+                                lappend details "$compo : [lindex $widgetInfo($address-$dataid-root.$part.$compo) $node-1]"
+                            }
+                          
+                            #if {"$dataid.$part" in $widgetInfo($address-selection)} {
+                            #     set outline_color grey50
+                            #}
+                            #if {"$dataid.$part" in $widgetInfo($address-activeselection)} {
+                            #     set outline_color red
+                            #}
+                            $win.t.can create polygon $face(px-1) $face(py-1) $face(px-2) $face(py-2) $face(px-3) $face(py-3) -fill $color -outline $outline_color -activewidth 3 -activeoutline black -tags "$dataid.$part $dataid.$part.$node"
+                            $win.t.can bind "$dataid.$part.$node" <Motion> [subst {
+                                set widgetInfo($address-message) "$dataid.$part.$node \n[join $details "\n"] "
+                            }]
+                            
+                        }
+                        set i 0
+                        set color 0
+                        set show 1
+                    }
+                    
+                }
+            } else {
+                # show by nodes
+                for {set i 0} {$i < $range} {incr i} {
+                    
+                    # clip
+                    set rclip [lindex $widgetInfo($address-$dataid-root.$part.$widgetInfo($address-clip)) $i]
+                    if {$rclip >  $widgetInfo($address-clipmax)} {continue}
+                    if {$rclip <  $widgetInfo($address-clipmin)} {continue}
+                    
+                    #position
+                    set rx [lindex $widgetInfo($address-$dataid-root.$part.$xtitle) $i]
+                    set ry [lindex $widgetInfo($address-$dataid-root.$part.$ytitle) $i]
+                    set px [glance_pix_x $address $rx]
+                    set py [glance_pix_y $address $ry]
+                    
+                    #colors
+                    if {[info exists widgetInfo($address-$dataid-root.$part.$ctitle)]} {
+                        set col [lindex $widgetInfo($address-$dataid-root.$part.$ctitle) $i]
+                        set col [expr {($col-$widgetInfo($address-colormin))/($widgetInfo($address-colormax)-$widgetInfo($address-colormin))}]
+                        set color [colorscale_get $rscale $col]
+                    } else {
+                        set color black
+                    }
+                    set outline_color $color
+                    
+                    # data to show
+                    set details $header
+                    foreach compo $node_components {
+                        lappend details "$compo : [lindex $widgetInfo($address-$dataid-root.$part.$compo) $i]"
+                    }
+                   
+                   
+                   
+                    # show selection                   
+                    #if {"$dataid.$part" in $widgetInfo($address-selection)} {
+                    #     set outline_color grey50
+                    #}
+                    #if {"$dataid.$part" in $widgetInfo($address-activeselection)} {
+                    #     set outline_color red
+                    #}
+                    
+                    
+                    if {$widgetInfo($address-showdiam)} {
+                        set diam [expr {[lindex $widgetInfo($address-$dataid-root.$part.epargne) $i] + 0.5*[lindex $widgetInfo($address-$dataid-root.$part.diam) $i]}]
+                        set h [expr {[glance_pix_x $address $diam]-[glance_pix_x $address 0]}]
+                    } else {
+                        set h 1
+                    }
+                    
+                    # render
+                    $win.t.can create oval [expr {$px -$h}] [expr {$py -$h}]  [expr {$px +$h}] [expr {$py +$h}] -outline $outline_color -activeoutline black -fill $color -activewidth 4 -tags "$dataid.$part $dataid.$part.$i"
+                    # binding local
+                    $win.t.can bind "$dataid.$part.$i" <Motion> [subst {
+                        set widgetInfo($address-message) "$dataid.$part.$i \n[join $details "\n"] "
+                    }]
+                }  
+            }
+            #binding global
+            $win.t.can bind "$dataid.$part" <ButtonPress> [subst {glance_select $win $address  "$dataid.$part"}]
+        }
+    }
+
+   
+   
+
+   
+    # draw frame an midlines
+    set xmin_pix [glance_pix_x $address $widgetInfo($address-xmin)]
+    set xmax_pix [glance_pix_x $address $widgetInfo($address-xmax)]
+    set ymin_pix [glance_pix_y $address $widgetInfo($address-ymin)]
+    set ymax_pix [glance_pix_y $address $widgetInfo($address-ymax)]
+    set xzero_pix [glance_pix_x $address 0.0]
+    set yzero_pix [glance_pix_y $address 0.0]
+             
+    
+    # draw zero axis if any
+    if {[expr { $widgetInfo($address-xmin)* $widgetInfo($address-xmax)}] < 0} {
+         $win.t.can create line $xzero_pix $ymin_pix $xzero_pix $ymax_pix -width 2 -fill black -tags "axis"
+    }
+    if {[expr { $widgetInfo($address-ymin)* $widgetInfo($address-ymax)}] < 0} {
+         $win.t.can create line $xmin_pix $yzero_pix $xmax_pix $yzero_pix -width 2 -fill black -tags "axis"
+    }
+    
+    
+    foreach frac {0 0.33 0.66 1 } {
+        set xfrac  [expr {$frac*$widgetInfo($address-xmin) + (1.-$frac)*$widgetInfo($address-xmax)}]
+        set yfrac  [expr {$frac*$widgetInfo($address-ymin) + (1.-$frac)*$widgetInfo($address-ymax)}]
+        set xfrac_pix [glance_pix_x $address $xfrac]
+        set yfrac_pix [glance_pix_y $address $yfrac]
+        $win.t.can create line $xfrac_pix  $ymin_pix $xfrac_pix $ymax_pix -fill grey80 -tags "axis"
+        canvas_text_vector $win.t.can $xfrac_pix $ymin_pix [format %.4g $xfrac] nw 11 45 black  "axis"    
+        $win.t.can create line $xmin_pix  $yfrac_pix $xmax_pix $yfrac_pix -fill grey80 -tags "axis"
+        canvas_text_vector $win.t.can $xmin_pix $yfrac_pix [format %.4g $yfrac] sw 11 45 black  "axis"
+    }
+    
+    
+    set xtit [expr {0.5*$widgetInfo($address-xmin)+ 0.5*$widgetInfo($address-xmax)}]
+    set ytit [expr {0.5*$widgetInfo($address-ymin)+ 0.5*$widgetInfo($address-ymax)}]
+    set xtit_pix [glance_pix_x $address $xtit]
+    set ytit_pix [glance_pix_y $address $ytit]
+    canvas_text_vector $win.t.can $xtit_pix $ymin_pix "$xtitle" nw 11 45 black  "axis" 
+    canvas_text_vector $win.t.can $xmin_pix $ytit_pix "$ytitle" sw 11 45  black "axis" 
+    
+        
+    
+    $win.t.can lower "axis"
+   
+    $win.t.can configure -scrollregion [ $win.t.can bbox all]
+    
+    smartpacker_update_visibility $win $address
+    set stop_time [clock milliseconds]
+    set widgetInfo($address-rendermessage) "Render time:\n[format "%0.3f" [expr { ($stop_time - $start_time)*0.001 }]] s."
+    
+}
+
+
+
+
+
+proc glance_reset_bounds {win address} {
+    global widgetInfo
+    
+    set xtitle [lindex $widgetInfo($address-projection) 0]
+    set ytitle [lindex $widgetInfo($address-projection) 1]
+    
+    
+    # get bounds
+    set boundx [glance_getbounds $win $address $xtitle]
+    set xmin [lindex $boundx 0]
+    set xmax [lindex $boundx 1]
+    
+    set boundy [glance_getbounds $win $address $ytitle]
+    set ymin [lindex $boundy 0]
+    set ymax [lindex $boundy 1]
+    
+   
+    # avoid null ranges
+    if {$ymin == $ymax} {
+        return "Cannot show data \n dimension $ytitle goes from $ymin to $ymax. "
+    }
+    if {$xmin == $xmax} {
+        return "Cannot show data \n dimension $xtitle goes from $xmin to $xmax. "
+    }
+    
+   
+    
+    
+    
+    set xrange [expr {$xmax-$xmin} ]
+    set yrange [expr {$ymax-$ymin} ]
+    
+    
+    # initialize bounds and scaling
+    set widgetInfo($address-xmin) $xmin
+    set widgetInfo($address-xmax) $xmax
+    set widgetInfo($address-ymin) $ymin
+    set widgetInfo($address-ymax) $ymax 
+    
+    
+    
+    if {"theta" ni $widgetInfo($address-projection) } {
+        if { $xrange > $yrange} {
+            set maxrange $xrange
+        } else {
+            set maxrange $yrange
+        }
+        set widgetInfo($address-xscale) [expr {0.8*$widgetInfo($address-widthcanvas)/$maxrange}]
+        set widgetInfo($address-yscale) [expr {0.8*$widgetInfo($address-heightcanvas)/$maxrange}]
+    } else {
+        set widgetInfo($address-xscale) [expr {0.8*$widgetInfo($address-widthcanvas)/$xrange}]
+        set widgetInfo($address-yscale) [expr {0.8*$widgetInfo($address-heightcanvas)/$yrange}]
+    }
+    return 1
+    
+}
+
+proc glance_select {win address tag} {
+    global widgetInfo
+    if  {$tag in $widgetInfo($address-selection)} {
+        set widgetInfo($address-activeselection) ""
+        lremove widgetInfo($address-selection)  $tag
+        set widgetInfo($address-message) "Removing  $tag from selection : \n -[join $widgetInfo($address-selection)  "\n -"] "
+    } else {
+        set widgetInfo($address-activeselection) "$tag"
+        lappend widgetInfo($address-selection) $tag
+        set widgetInfo($address-selection) [ lsort $widgetInfo($address-selection)]
+        set widgetInfo($address-message) "Adding  $tag to selection : \n -[join $widgetInfo($address-selection)  "\n -"]"
+    }
+    glance_render $win $address
+    
+}
+
+
+proc glance_getbounds {win address  component} {
+    global widgetInfo
+    set min +1e40
+    set max -1e40
+    
+    foreach dataid  $widgetInfo($address-dataids) {
+        foreach part $widgetInfo($address-$dataid-root.children) {
+            if {[info exists widgetInfo($address-$dataid-root.$part.$component)]} {    
+                if {[string is double [lindex  $widgetInfo($address-$dataid-root.$part.$component)  0]] == 0} {return "nobounds"}
+                set res [list_bounds  $widgetInfo($address-$dataid-root.$part.$component) $min $max]
+                set min [lindex $res 0]
+                set max [lindex $res 1]
+            } else {
+                log "$dataid-root.$part.$component not found"
+            }
+        }
+    }
+    return "$min $max"
+}
+
+proc glance_parsecontent {win address dataid filename} {
+    set start_time [clock milliseconds]
+    
+    global widgetInfo
+    
+    lappend widgetInfo($address-dataids) $dataid
+    
+    
+    set widgetInfo($address-$dataid-filename) $filename
+    set chout [ open $filename r ]
+    set out [ split [ read $chout] "\n" ]
+    close $chout
+
+    set readin 0
+    set path "none"
+    
+    set data ""
+    foreach line $out {
+        if {[string index $line end] == ":"} {
+            set path [string range $line 0 end-2]
+        } else {
+            set data "$data $line"
+        }
+        if {$line == ""} {
+            set data [string map {" " ""} $data ]
+            set data [string trimright $data ","]
+            set data [split $data ","]
+            set widgetInfo($address-$dataid-$path) $data
+            set data ""
+            set path "none"
+        }
+    }
+    
+    
+    set list_components ""
+    set list_conn ""
+    
+    set list_proj ""
+    foreach part $widgetInfo($address-$dataid-root.children) {
+        foreach compo $widgetInfo($address-$dataid-root.$part.children) {
+            if {$compo ni "conn id"} {
+                lappend list_components $compo
+            }
+            if {$compo in "conn"} {
+                lappend list_conn $compo
+            }
+            
+        }
+    }
+    set list_components [lsort -unique -dictionary $list_components ]
+    
+    foreach proj {"x y" "x z" "z y" "theta x"  "x r"  "theta r" "y curvi" "z curvi" "theta curvi" } {
+        set ok 1
+        foreach dir $proj {
+            if {$dir ni $list_components} {set ok 0}
+        }
+        
+        if {$ok } {lappend list_proj $proj}
+    }
+    
+    
+    if {"epargne" in $list_components} {
+        set widgetInfo($address-showdiam) 1
+    } else {
+        set widgetInfo($address-showdiam) 0
+        
+    }
+    
+    
+    set widgetInfo($address-$dataid-listcomponents) $list_components
+    set widgetInfo($address-$dataid-list_proj) $list_proj
+    set widgetInfo($address-$dataid-list_conn) $list_conn
+    
+    glance_updateproj $win $address
+    glance_updatecomponents $win $address $dataid
+    
+    
+    
+    glance_resets $win $address "clip"
+    glance_resets $win $address  "color"
+    
+    set stop_time [clock milliseconds]
+    return "Loading time :  [format "%0.3f" [expr { ($stop_time - $start_time)*0.001 }]] s."
+}
+
+proc glance_updatecomponents {win address dataid} {
+    global widgetInfo
+
+    set list_components $widgetInfo($address-$dataid-listcomponents)
+    
+    $win.c.color configure -values $list_components
+    if {$widgetInfo($address-color) ni $list_components} {
+        set widgetInfo($address-color) [lindex $list_components 0]
+    }
+    
+    $win.c.clip configure -values $list_components
+    if {$widgetInfo($address-clip) ni $list_components} {
+        set widgetInfo($address-clip) [lindex $list_components 0]
+    }
+      
+}
+
+proc glance_updateproj {win address} {
+    global widgetInfo
+        
+    set list_proj ""
+    foreach dataid  $widgetInfo($address-dataids) {
+        if {$list_proj == ""} {set list_proj $widgetInfo($address-$dataid-list_proj)}
+        
+        if {$list_proj != $widgetInfo($address-$dataid-list_proj)} {
+            set new_list ""
+            foreach proj $list_proj {
+                if {$proj in $widgetInfo($address-$dataid-list_proj)} {
+                    lappend new_list $proj
+                }
+            }
+            set list_proj $new_list
+        }
+        
+        
+    }
+    
+    $win.c.projection configure -values $list_proj
+    if {$widgetInfo($address-projection) ni $list_proj} {
+        set widgetInfo($address-projection) [lindex $list_proj 0]
+    }
+}
+
+
+proc glance_resets { win address what} {
+    global widgetInfo
+    
+    switch $what {
+        "clip" {
+            set res [glance_getbounds $win $address  $widgetInfo($address-clip)]
+            if {$res == "nobounds"} {
+                warning " Cannot clip using  $widgetInfo($address-clip)"
+                set widgetInfo($address-clip) "x"
+                return
+                #glance_resets $win $address what
+            }
+            set widgetInfo($address-clipmin) [lindex $res 0 ]
+            set widgetInfo($address-clipmax) [lindex $res 1 ]
+                    
+        }
+        "color" {
+            set res [glance_getbounds $win $address  $widgetInfo($address-color)]
+            if {$res == "nobounds"} {
+                warning " Cannot color using  $widgetInfo($address-color)"
+                set widgetInfo($address-color) "x"
+                return
+                #glance_resets $win $address what
+            }
+            set widgetInfo($address-colormin) [lindex $res 0 ]
+            set widgetInfo($address-colormax) [lindex $res 1 ]
+            if {$widgetInfo($address-colormin) == $widgetInfo($address-colormax)} {
+                set widgetInfo($address-colormax) [expr {$widgetInfo($address-colormin) + 1.}]
+            }
+                    
+        }
+    }
+    return 1
+}
+
+proc glance_pix_x { address x } {
+    global widgetInfo
+    set xpix [expr {($x -$widgetInfo($address-xmin)) * $widgetInfo($address-xscale)}]
+    return $xpix
+}
+proc glance_pix_y { address y} {
+    global widgetInfo
+    set ypix [expr {($widgetInfo($address-ymax) -$y) * $widgetInfo($address-yscale)}]
+    return $ypix
+    
+}
+proc glance_pix_realx { address xpix} {
+    global widgetInfo
+    set x [expr {$widgetInfo($address-xmin) + $xpix/$widgetInfo($address-xscale)}]
+    return $x
+}
+proc glance_pix_realy { address ypix} {
+    global widgetInfo
+    set y [expr {$widgetInfo($address-ymax) - $ypix/$widgetInfo($address-yscale)}]
+    return $y
+}
+
+proc glance_showlocation {win address} {
+    global widgetInfo
+    $win.t.can delete "pointer"
+    set x [$win.t.can canvasx [expr {[winfo pointerx $win.t.can] - [winfo rootx $win.t.can]}]]
+    set y [$win.t.can canvasy [expr {[winfo pointery $win.t.can] - [winfo rooty $win.t.can]}]]
+    set realx [glance_pix_realx  $address $x  ]
+    set realy [glance_pix_realy  $address $y  ]
+    set widgetInfo($address-position)  "[format %+.4f $realx]\n[format %+.4f $realy]"
+    canvas_text_highlighted $win.t.can $x $y  $widgetInfo($address-position) "pointer"
+}
+
+
+
+proc glance_scrollupdate { win address xzoom yzoom} {
+    global widgetInfo
+    set width $widgetInfo($address-width)
+    set height $widgetInfo($address-height)
+    set widthcanvas $widgetInfo($address-widthcanvas)
+    set heightcanvas $widgetInfo($address-heightcanvas)
+    
+    set widthcanvas [expr  $widthcanvas*$xzoom ]
+    set heightcanvas [expr $heightcanvas*$yzoom ]
+    
+    set widgetInfo($address-widthcanvas) $widthcanvas
+    set widgetInfo($address-heightcanvas) $heightcanvas
+    
+    set scroll_factor_x [expr 1.0/$width*(1.0-$width*1.0/$widthcanvas)]
+    if { $width > $widthcanvas} { set scroll_factor_x 0}
+    set widgetInfo($address-scroll_factor_x) $scroll_factor_x
+    set scroll_factor_y [expr 1.0/$height*(1.0-$height*1.0/$heightcanvas)]
+    if { $height > $heightcanvas} { set scroll_factor_y 0}
+    set widgetInfo($address-scroll_factor_y) $scroll_factor_y
+    
+}
+
+# to move the canvases using Control_move binding
+proc glance_zoom { win address zoomfactor} {
+    
+    
+    
+    global widgetInfo
+    
+    set zoom [lindex [split $widgetInfo($address-zoom) " "] 1]
+    log "zoom $zoom"
+    if {$zoomfactor == 1 } {
+        set zoomfactor [expr {100./$zoom}]
+        set zoom 100
+     } else {
+        set zoom [expr {$zoom * $zoomfactor} ]
+     }
+     set widgetInfo($address-zoom) "Zoom: $zoom"
+     set widgetInfo($address-xscale) [expr {$widgetInfo($address-xscale) * $zoomfactor} ]
+     set widgetInfo($address-yscale) [expr {$widgetInfo($address-yscale) * $zoomfactor} ]
+     
+     glance_render $win $address
+     $win.t.can configure -scrollregion [ $win.t.can bbox all ]
+     
+   
+}
+
+# to move the canvases using Control_move binding
+proc glance_move { win address x y} {
+    global widgetInfo
+    
+    set xv [expr $x * $widgetInfo($address-scroll_factor_x)]
+    set yv [expr $y * $widgetInfo($address-scroll_factor_y)]
+    $win.t.can xview moveto $xv
+    $win.t.can yview moveto $yv
+}
+
+proc glance_purge {win address } {
+    global widgetInfo
+    destroy $win.t.can
+    canvas $win.t.can  -yscrollcommand [list $win.t.sby set] -xscrollcommand [list $win.t.sbx set] -width $widgetInfo($address-widthcanvas) -height $widgetInfo($address-heightcanvas)
+    grid $win.t.can -row 1 -column 1 -sticky news
+    update
+}
+
+proc glance_check {win address} {
+    global widgetInfo
+   
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_graph.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_graph.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_graph.tcl	(revision 4775)
@@ -0,0 +1,608 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# GRAPH CREATION
+
+proc graph_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-message) ""
+    set widgetInfo($address-accepted_keys) {"name" "xtitle" "ytitle" "color" "type"}
+    
+    ttk::frame $win 
+    eval $widgetInfo(packme-$win)
+
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]   
+    ttk::label $win.lb -text "$title" 
+    ttk::frame $win.t 
+    
+    pack $win.lb -side top -pady 3
+    pack $win.t -side top -pady {0 5}
+    
+    set size_v [expr { (0.6)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size_h [expr { (1)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size [split [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "size" "1;1" ] ";"]
+    set size_h [expr {int([lindex $size 1]*1.*$size_h)}]
+    set size_v [expr {int([lindex $size 1]*1.*$size_v)}]
+    
+    set widgetInfo($address-width) $size_h
+    set widgetInfo($address-height) $size_v
+    set widgetInfo($address-widthcanvas) $size_h
+    set widgetInfo($address-heightcanvas) $size_v
+    
+    
+    # graph part
+    canvas $win.t.can  -yscrollcommand [list $win.t.sby set] -xscrollcommand [list $win.t.sbx set]   -width $size_h -height $size_v 
+    ttk::scrollbar $win.t.sby -orient vertical -command [list $win.t.can yview]
+    ttk::scrollbar $win.t.sbx -orient horizontal -command [list $win.t.can xview]
+    
+    grid $win.t.can -row 1 -column 0 -sticky news 
+    grid $win.t.sby -row 1 -column 1 -sticky ns
+    grid $win.t.sbx -row 2 -column 0 -sticky ew
+    
+    
+    
+    # controls part
+    ttk::frame $win.c
+    pack $win.c -side top -fill x
+    # export csv
+    ttk::button $win.c.csv  -image icon_clipboard -command [subst {
+        clipboard clear
+        clipboard append \[graph_var_to_csv $win $address\]
+        success "Content of graph copied into clipboard in CSV format."
+    }]
+    balloon $win.c.csv  "Export CSV to clipboard"
+    pack $win.c.csv -side left
+    
+    # export xmgrace
+    ttk::button $win.c.xmgr  -image icon_graph -command [subst {
+        clipboard clear
+        clipboard append \[graph_var_to_xmgrace_project $win $address\]
+        log "Try to open graph into XMGR"
+    }]
+    balloon $win.c.xmgr "Open in XMGRACE"
+    pack $win.c.xmgr -side left
+    
+    
+    # message label
+    ttk::label $win.c.message -textvariable widgetInfo($address-message)
+    pack $win.c.message -side left
+    
+    #add the check/refresh procedure to the bindings of the variable
+   
+    append widgetInfo($address-refresh) [ subst { graph_refresh $win $address}]
+    append widgetInfo($address-check) [subst { graph_check $win $address}]
+    finishWidget
+    
+    #trick?
+    bind $win.t.can <ButtonPress-1> {+; focus %W}
+    
+    bind $win.t.can <Motion> [subst {graph_showlocation $win  $address}]
+    
+    #  zoom binding
+    #bind $win.t.can <KeyPress-x> [ subst {graph_zoom $address $win 0.8 1.0}]
+    #bind $win.t.can <KeyPress-X> [ subst {graph_zoom $address $win 1.2 1.0}]
+    #bind $win.t.can <KeyPress-y> [ subst {graph_zoom $address $win 1.0 0.8}]
+    #bind $win.t.can <KeyPress-Y> [ subst {graph_zoom $address $win 1.0 1.2}]
+    bind $win.t.can <KeyPress-z> [ subst {graph_zoom $address $win 0.8 0.8}]
+    bind $win.t.can <KeyPress-Z> [ subst {graph_zoom $address $win 1.2 1.2}]
+    
+    # ctrl move
+    bind $win.t.can <Control-Motion> [ subst {graph_move $win $address %x %y }]
+    
+    graph_scrollupdate $win $address 1.0 1.0
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc graph_refresh {win address} {
+    global widgetInfo
+    #$win.t.can create rect 0 0 $widgetInfo($address-widthcanvas) $widgetInfo($address-heightcanvas)  -fill white -tags "xscalable yscalable"
+   
+    $win.t.can delete all
+    
+    set xmin 1000000000
+    set xmax -1000000000
+    set ymin 1000000000
+    set ymax -1000000000
+    set xtitle ""
+    set ytitle ""
+    
+    # first pass, to get bounds
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        set ds_name [graph_parsecontent $address $dataset name]
+        set ds_xtitle [graph_parsecontent $address $dataset xtitle]
+        set ds_ytitle [graph_parsecontent $address $dataset ytitle]
+        set ds_color [graph_parsecontent $address $dataset color]
+        set ds_type [graph_parsecontent $address $dataset type]
+        set dsraw [graph_parsecontent $address $dataset raw]
+        set ds_length  [graph_parsecontent $address $dataset length]
+        
+        if {$ds_length <= 1} {
+            set msg_err "Void datased in graph $address"
+            warning $msg_err
+            return 
+        }
+        
+        
+        lappend xtitle $ds_xtitle 
+        lappend ytitle $ds_ytitle 
+        
+        for {set i 1} {$i <= $ds_length} {incr i} {
+            set x [lindex $dsraw [expr {2*$i-2}]]
+            set y [lindex $dsraw [expr {2*$i-1}]]
+            if {$x>$xmax} {set xmax $x}
+            if {$x<$xmin} {set xmin $x}
+            if {$y>$ymax} {set ymax $y}
+            if {$y<$ymin} {set ymin $y}
+        }
+        
+    }
+
+    
+    set xtitle [join [lsort -unique $xtitle] ", "]
+    set ytitle [join [lsort -unique $ytitle] ", "]
+    
+    if {$ymin == $ymax} {
+        set ymin [expr {$ymin-1.0}]
+        set ymax [expr {$ymax+1.0}]
+    }
+    if {$xmin == $xmax} {
+        set xmin [expr {$xmin-1.0}]
+        set xmax [expr {$xmax+1.0}]
+    }
+    
+    
+    # initialize bounds and scaling
+    set widgetInfo($address-xmin) $xmin
+    set widgetInfo($address-xmax) $xmax
+    set widgetInfo($address-ymin) $ymin
+    set widgetInfo($address-ymax) $ymax 
+    
+    set widgetInfo($address-xscale) [expr {0.75 *$widgetInfo($address-widthcanvas) /($widgetInfo($address-xmax)-$widgetInfo($address-xmin))}]
+    set widgetInfo($address-yscale) [expr {0.75*$widgetInfo($address-heightcanvas)/($widgetInfo($address-ymax)-$widgetInfo($address-ymin))}]
+   
+    
+   
+   
+    # draw frame an midlines
+    set xmin_pix [graph_pix_x $address $xmin]
+    set xmax_pix [graph_pix_x $address $xmax]
+    set ymin_pix [graph_pix_y $address $ymin]
+    set ymax_pix [graph_pix_y $address $ymax]
+    set xzero_pix [graph_pix_x $address 0.0]
+    set yzero_pix [graph_pix_y $address 0.0]
+             
+    
+    # draw zero axis if any
+    if {[expr {$xmin*$xmax}] < 0} {
+         $win.t.can create line $xzero_pix $ymin_pix $xzero_pix $ymax_pix -width 2 -fill black -tags "xscalable yscalable axis"
+    }
+    if {[expr {$ymin*$ymax}] < 0} {
+         $win.t.can create line $xmin_pix $yzero_pix $xmax_pix $yzero_pix -width 2 -fill black -tags "xscalable yscalable axis"
+    }
+    
+    
+    #$win.t.can create text $xmax_pix $ymin_pix -text "$xmax, $ymin" -anchor "se" -tags "xscalable yscalable"
+    #$win.t.can create text $xmin_pix $ymax_pix -text "$xmin, $ymax" -anchor "nw" -tags "xscalable yscalable"
+    foreach frac {0 0.2 0.4 0.6 0.8 1.0 } {
+        set xfrac  [expr {$frac * $xmin + (1.-$frac)*$xmax}]
+        set yfrac  [expr {$frac * $ymin + (1.-$frac)*$ymax}]
+        set xfrac_pix [graph_pix_x $address $xfrac]
+        set yfrac_pix [graph_pix_y $address $yfrac]
+        $win.t.can create line $xfrac_pix  $ymin_pix $xfrac_pix $ymax_pix -fill grey80 -tags "xscalable yscalable axis"
+        canvas_text_vector $win.t.can $xfrac_pix $ymin_pix [format %.4g $xfrac] nw 11 45 black  "xscalable yscalable axis"    
+        $win.t.can create line $xmin_pix  $yfrac_pix $xmax_pix $yfrac_pix -fill grey80 -tags "xscalable yscalable axis"
+        canvas_text_vector $win.t.can $xmin_pix $yfrac_pix [format %.4g $yfrac] sw 11 45 black  "xscalable yscalable axis"
+    }
+    
+    
+    set xtit [expr {0.5 * $xmin + 0.5*$xmax}]
+    set ytit [expr {0.5 * $ymin + 0.5*$ymax}]
+    set xtit_pix [graph_pix_x $address $xtit]
+    set ytit_pix [graph_pix_y $address $ytit]
+    #canvas_text_vector $win.t.can $xtit_pix $ymin_pix "$xtitle" nw 11 45 black  "xscalable yscalable axis" 
+    #canvas_text_vector $win.t.can $xmin_pix $ytit_pix "$ytitle" sw 11 45  black "xscalable yscalable axis" 
+    
+    canvas_text_vector $win.t.can $xmax_pix $ymin_pix "$xtitle" sw 11 -90 black  "xscalable yscalable axis" 
+    canvas_text_vector $win.t.can $xmin_pix $ymax_pix "$ytitle" se 11 0  black "xscalable yscalable axis" 
+        
+    
+    
+# second pass pass, to draw 
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        
+        set ds_name [graph_parsecontent $address $dataset name]
+        set ds_tag [string map {" " "_"} $ds_name]
+        set ds_xtitle [graph_parsecontent $address $dataset xtitle]
+        set ds_ytitle [graph_parsecontent $address $dataset ytitle]
+        set ds_color [graph_parsecontent $address $dataset color]
+        set ds_type [graph_parsecontent $address $dataset type]
+        set dsraw [graph_parsecontent $address $dataset raw]
+        set ds_length  [graph_parsecontent $address $dataset length]
+        
+       
+        
+        set ds_rawpix ""
+        
+        set tags "xscalable yscalable $ds_tag"
+            
+        for {set i 1} {$i <= $ds_length} {incr i} {
+            set shade [expr {1.0*($ds_length-$i)/($ds_length-1)}]
+            set x [lindex $dsraw [expr {2*$i-2}]]
+            set y [lindex $dsraw [expr {2*$i-1}]]
+            set xpix [graph_pix_x $address $x]
+            set ypix [graph_pix_y $address $y]
+            
+            
+            # Symbols
+            if {"circle" in $ds_type} {
+                set h 5
+                $win.t.can create oval [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix+$h}] -fill [shadeColor $ds_color $shade]   -width 0 -tags $tags -activewidth 3
+                set h 5
+                $win.t.can create oval [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix+$h}] -outline  $ds_color -tags $tags -activewidth 3
+            }
+            if {"square" in $ds_type} {
+                set h 5
+                $win.t.can create rectangle [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix+$h}] -fill [shadeColor $ds_color $shade] -width 0 -tags $tags -activewidth 3
+                set h 5
+                $win.t.can create rectangle [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix+$h}]  -outline  $ds_color -tags $tags -activewidth 3
+                
+            }
+            if {"triangle" in $ds_type} {
+                set h 5
+                $win.t.can create polygon [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix-$h}] [expr {$xpix}] [expr {$ypix+$h}] -fill [shadeColor $ds_color $shade] -width 0  -tags $tags -activewidth 3
+                set h 5
+                $win.t.can create line [expr {$xpix-$h}] [expr {$ypix-$h}] [expr {$xpix+$h}] [expr {$ypix-$h}] [expr {$xpix}] [expr {$ypix+$h}] [expr {$xpix-$h}] [expr {$ypix-$h}] -fill $ds_color -tags $tags -activewidth 3
+                
+            }
+            if {"diamond" in $ds_type} {
+                set h 5
+                $win.t.can create polygon $xpix [expr {$ypix-$h}] [expr {$xpix+$h}] $ypix $xpix [expr {$ypix+$h}] [expr {$xpix-$h}] $ypix  -fill [shadeColor $ds_color $shade] -width 0  -tags $tags -activewidth 3
+                set h 5
+                $win.t.can create line $xpix [expr {$ypix-$h}] [expr {$xpix+$h}] $ypix $xpix [expr {$ypix+$h}] [expr {$xpix-$h}] $ypix  $xpix [expr {$ypix-$h}]  -fill $ds_color -tags $tags -activewidth 3
+                
+            }           
+            # line to zero
+            if {"toy0" in $ds_type} {
+                $win.t.can create line [expr {$xpix}] [expr {$yzero_pix}] [expr {$xpix}] [expr {$ypix}] -fill $ds_color  -tags $tags -activewidth 3
+            }
+            
+            # labels 
+            if {"lblall" in $ds_type} {
+                canvas_text_vector $win.t.can $xpix $ypix "$x, $y" se 9 45 $ds_color $tags
+            }
+            
+            # line
+            if { "line" in $ds_type} {
+                lappend ds_rawpix $xpix $ypix
+            }
+        }
+        
+        #last label
+        if {"lbllast" in $ds_type} {
+                canvas_text_vector $win.t.can $xpix $ypix "$x, $y" se 9 45 $ds_color $tags
+        }
+        
+        # line
+        if {"line" in $ds_type} {
+            $win.t.can create line $ds_rawpix -fill $ds_color -width 2 -activewidth 3 -tags $tags
+        }
+        
+        $win.t.can bind $ds_tag <Enter> [subst {
+            set widgetInfo($address-message) "Dataset : $ds_name"
+        }]
+        $win.t.can bind $ds_tag <Leave> [subst {set widgetInfo($address-message) ""}]
+        
+        
+        
+    }
+   
+    $win.t.can lower "axis"
+   
+    $win.t.can configure -scrollregion [ $win.t.can bbox all]
+    
+    smartpacker_update_visibility $win $address
+    
+    #canvas_makegif $win.t.can "$widgetInfo($address-name).gif"
+    
+}
+
+
+proc graph_parsecontent {address curve_data arg} {
+    global widgetInfo
+    
+    set ds [split $curve_data ";"]
+    set dsi(name) "no name"
+    set dsi(xtitle) "no xtitle"
+    set dsi(ytitle) "no ytitle"
+    set dsi(color) "black"
+    set dsi(type) "circle_line"
+    set dsi(raw) ""
+    foreach item $ds {
+        if {[string match "*=*" $item] == 1} {
+            set key [lindex [split $item "="]  0]
+            set value [lindex [split $item "="] 1]
+            if {$key in $widgetInfo($address-accepted_keys)} {
+                set dsi($key)  $value
+            } else {
+                debug "Graph key $key not recognized among $widgetInfo($address-accepted_keys)"
+            }
+        } else {
+            if {[string is double $item]} {
+                lappend dsi(raw) $item
+            } {
+                log "Warning : graph $address ; item $item not understood"
+            }
+        }
+    }
+    set dsi(type) [split $dsi(type) "_"]
+    set dsi(length) [expr {0.5*[llength $dsi(raw)]}]
+    return $dsi($arg)
+}
+
+proc graph_pix_x { address x } {
+    global widgetInfo
+    set xpix [expr {($x -$widgetInfo($address-xmin)) * $widgetInfo($address-xscale)}]
+    return $xpix
+}
+proc graph_pix_y { address y} {
+    global widgetInfo
+    set ypix [expr {($widgetInfo($address-ymax) -$y) * $widgetInfo($address-yscale)}]
+    return $ypix
+    
+}
+proc graph_pix_realx { address xpix} {
+    global widgetInfo
+    set x [expr {$widgetInfo($address-xmin) + $xpix/$widgetInfo($address-xscale)}]
+    return $x
+}
+proc graph_pix_realy { address ypix} {
+    global widgetInfo
+    set y [expr {$widgetInfo($address-ymax) - $ypix/$widgetInfo($address-yscale)}]
+    return $y
+}
+
+proc graph_showlocation {win address} {
+    global widgetInfo
+    $win.t.can delete "pointer"
+    set x [$win.t.can canvasx [expr {[winfo pointerx $win.t.can] - [winfo rootx $win.t.can]}]]
+    set y [$win.t.can canvasy [expr {[winfo pointery $win.t.can] - [winfo rooty $win.t.can]}]]
+    set realx [graph_pix_realx  $address $x  ]
+    set realy [graph_pix_realy  $address $y  ]
+    set widgetInfo($address-position)  "[format %+.4f $realx]\n[format %+.4f $realy]"
+    canvas_text_highlighted $win.t.can $x $y  $widgetInfo($address-position) "pointer"
+}
+
+
+
+proc graph_scrollupdate { win address xzoom yzoom} {
+    global widgetInfo
+    set width $widgetInfo($address-width)
+    set height $widgetInfo($address-height)
+    set widthcanvas $widgetInfo($address-widthcanvas)
+    set heightcanvas $widgetInfo($address-heightcanvas)
+    
+    set widthcanvas [expr  $widthcanvas*$xzoom ]
+    set heightcanvas [expr $heightcanvas*$yzoom ]
+    
+    set widgetInfo($address-widthcanvas) $widthcanvas
+    set widgetInfo($address-heightcanvas) $heightcanvas
+    
+    set scroll_factor_x [expr 1.0/$width*(1.0-$width*1.0/$widthcanvas)]
+    if { $width > $widthcanvas} { set scroll_factor_x 0}
+    set widgetInfo($address-scroll_factor_x) $scroll_factor_x
+    set scroll_factor_y [expr 1.0/$height*(1.0-$height*1.0/$heightcanvas)]
+    if { $height > $heightcanvas} { set scroll_factor_y 0}
+    set widgetInfo($address-scroll_factor_y) $scroll_factor_y
+    
+}
+
+# to move the canvases using Control_move binding
+proc graph_zoom { address win xzoom yzoom} {
+    global widgetInfo
+     set y0 0
+     set x0 0
+     $win.t.can scale xscalable $x0 $y0 $xzoom 1
+     $win.t.can scale yscalable $x0 $y0 1 $yzoom
+     
+     set widgetInfo($address-xscale) [expr {$widgetInfo($address-xscale) * $xzoom} ]
+     set widgetInfo($address-yscale) [expr {$widgetInfo($address-yscale) * $yzoom} ]
+     
+     $win.t.can configure -scrollregion [ $win.t.can bbox all]
+     graph_scrollupdate $win $address $xzoom $yzoom
+   
+}
+
+
+proc graph_var_to_csv {win address} {
+    global widgetInfo
+    # first pass, to get bounds
+    set maxrow 0
+    set col 0
+    set colp1 1
+    
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        
+        set ds_name [graph_parsecontent $address $dataset name]
+        set ds_xtitle [graph_parsecontent $address $dataset xtitle]
+        set ds_ytitle [graph_parsecontent $address $dataset ytitle]
+        set dsraw [graph_parsecontent $address $dataset raw]
+        set ds_length  [graph_parsecontent $address $dataset length]
+        
+        
+        set csv_data(0-$col) $ds_name
+        set csv_data(1-$col) $ds_xtitle
+        set csv_data(1-$colp1) $ds_ytitle     
+        set row 2
+        foreach {x y} $dsraw {
+            set csv_data($row-$col) $x
+            set csv_data($row-$colp1) $y
+            incr row
+        }
+        
+        incr col 2
+        incr colp1 2
+        set maxrow [expr {max($row,$maxrow)}]
+        
+    }
+    set result ""
+    
+    set cell_list [array names csv_data]
+    for {set r 0 } {$r < $maxrow } {incr r} {
+        set line ""
+        for {set c 0 } {$c < $colp1 } {incr c} {
+            set cell "$r-$c"
+            if {$cell in $cell_list} {
+                lappend line $csv_data($cell)
+            } else {
+                lappend line {}
+            }
+        }
+        set result "$result [join $line ";" ] \n"
+    }
+    
+    array unset csv_data
+    return  $result
+}
+
+
+proc graph_var_to_xmgrace_project {win address} {
+    global widgetInfo
+    
+    set result ""
+    lappend result "# Grace project file"
+    lappend result "# "
+    lappend result "@with g0"
+    lappend result "@    legend on"
+    
+    
+    # first loop to setup the graphs
+    set ds_id 0
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        set ds_name [graph_parsecontent $address $dataset name]
+        set ds_xtitle [graph_parsecontent $address $dataset xtitle]
+        set ds_ytitle [graph_parsecontent $address $dataset ytitle]
+        set ds_color [graph_parsecontent $address $dataset color]
+        set ds_type [graph_parsecontent $address $dataset type]
+        
+        # convert color
+        set xm_col 1
+        switch $ds_color {
+            "black" {
+                set xm_col 1
+            }
+            "red" {
+                set xm_col 2
+            }
+            "blue" {
+                set xm_col 4
+            }
+            "green4" {
+                set xm_col 15
+            }
+        }
+        # convert symbol
+        set xm_sym 0
+        if {"circle" in $ds_type} {set xm_sym 1}
+        if {"square" in $ds_type} {set xm_sym 2}
+        if {"triangle" in $ds_type} {set xm_sym 6}
+        if {"diamond" in $ds_type} {set xm_sym 3}
+        
+        lappend result "@    xaxis  label \"$ds_xtitle\""
+        lappend result "@    yaxis  label \"$ds_ytitle\""
+        lappend result "@    s$ds_id  symbol $xm_sym"
+        lappend result "@    s$ds_id  symbol color $xm_col"
+        lappend result "@    s$ds_id  symbol fill color $xm_col"
+        lappend result "@    s$ds_id  symbol fill pattern 8"
+        lappend result "@    s$ds_id  line color $xm_col"
+        lappend result "@    s$ds_id  baseline off"
+        lappend result "@    s$ds_id  dropline off"
+        lappend result "@    s$ds_id  legend \"$ds_name\""
+        
+        incr ds_id
+    }
+    
+     # second loop to fill the data
+    set ds_id 0
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        set dsraw [graph_parsecontent $address $dataset raw]
+        lappend result "@target G0.S$ds_id"
+        lappend result "@type xy"
+        foreach {x y} $dsraw {
+            lappend result "$x $y"
+        }
+        lappend result "&"
+        incr ds_id
+    }
+    
+    
+    set result [join $result "\n"]
+    array unset xmgr_data
+    set xmgracefile [open "./tmp.agr" w+]
+    puts $xmgracefile $result
+    close $xmgracefile
+    exec_script "xmgrace ./tmp.agr"
+    return  
+}
+
+
+# to move the canvases using Control_move binding
+proc graph_move { win address x y} {
+    global widgetInfo
+    set xv [expr $x * $widgetInfo($address-scroll_factor_x)]
+    set yv [expr $y * $widgetInfo($address-scroll_factor_y)]
+    $win.t.can xview moveto $xv
+    $win.t.can yview moveto $yv
+}
+
+
+proc graph_check {win address} {
+    global widgetInfo
+   
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_gui.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_gui.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_gui.tcl	(revision 4775)
@@ -0,0 +1,341 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# hello world
+
+# Create a GUI associated to a tree 
+proc gui_create { args } {
+    global widgetInfo
+    global XMLtree
+    global initializedSolver
+    global solverPath
+    global libraryPath
+    global solverOrder
+    
+    set address "root"
+    set initializedSolver ""
+    
+    # An initialization is mandatory for the root node but the initWidget doesn't fit requirements for the root node
+    set widgetInfo($address-require) ""
+    set widgetInfo($address-status) 0
+    set widgetInfo($address-check) ""
+    set widgetInfo($address-refresh) ""
+    set widgetInfo($address-refreshStatus) ""
+    
+    # loop on keywords provided
+    foreach { keyword argument } $args {
+        # test keywords
+        if {![string match -* $keyword ]} {
+            tk_messageBox -icon error -message "Error : keyword must be like -*"
+            return
+        }
+        # assign keywords
+        switch -- $keyword {
+            "-path" {
+               set win $argument
+            }
+            "-solver" {
+               set solver $argument
+            }
+            default {
+                tk_messageBox -icon error -message  "Error : $keyword is not recognized"
+                return
+            }
+        }
+    }
+    set widgetInfo($address-refreshStatus) ""
+    
+    set win_GUI [ solverframe_create -path_father $win -address "root"]
+   
+    # ensure that destroying the GUI frame will wipe out its associated memory
+    bind $win_GUI <Destroy> "gui_destroy $solver"
+    
+    # start the recursive creation of widgets
+    
+    ######## Sort the children according to their "order" attribute
+    
+    # First, get children and associated orders
+    foreach child [dTree_getChildren $XMLtree "root"]  {
+        set order "0"
+        set childAndOrder ""
+        # Retrieve order from either dict solver order (set solvers_to_add) or XML if absent
+        if { $child in [array names solverOrder]} {
+            set order $solverOrder($child)
+        } else {
+            set order [dTree_tryGetAttribute $XMLtree "root $child" order "9999"]
+        }
+        lappend childAndOrder $order
+        lappend childAndOrder $child
+        lappend childrenAndOrder $childAndOrder
+    }
+    
+    # Then, sort
+    set childrenAndOrder [lsort -index 0 -integer $childrenAndOrder]
+    # Finally, store them
+    foreach child $childrenAndOrder {
+        lappend sortedChildren [lindex $child 1]
+    }
+
+    ############ Loop over children
+    foreach solv $sortedChildren {
+        if {$solv == "DATA"} {
+            continue
+        }
+        set initializedSolver $solv
+        set solverPath [file join $libraryPath $solv]
+        gui_addpart -address root.$solv -path_father $win_GUI -class solver
+    }
+    
+    
+    return $win_GUI
+}
+
+proc gui_addpart { args } {
+    global GuiInfo
+    global DStree
+    global XMLtree
+    global additionalWidgets
+    
+    # set style . If style flat, simple frames will be used instead of labelframes
+    # used for labelframed widgets in modelxor or multiple
+    set part_style "normal"    
+    
+    # loop on keywords provided
+    foreach { keyword argument } $args {
+        # test keywords
+        if {![string match -* $keyword ]} {
+            tk_messageBox -icon error -message "Error : keyword must be like -*"
+            return
+        }
+        # assign keywords
+        switch -- $keyword {
+            "-address" {
+                set address $argument
+                set full_address_XML [split $argument "."]
+                set node_XML [lindex $full_address_XML end ]
+                set parent_address_XML [lrange $full_address_XML 0 end-1 ]
+                set parent_address [join $parent_address_XML .]
+            }
+            "-path_father" {
+               set path_father $argument
+            }
+            "-class" {
+                set part_class $argument
+            }
+            "-style" {
+                set part_style $argument
+            }
+            
+            default {
+                tk_messageBox -icon error -message  "Error : $keyword is not recognized"
+                return
+            }
+        }
+    }
+        
+
+    switch -glob $part_class {
+        "solver" {
+            set part_winactive [solverframe_add -path_father $path_father -address $address]
+        }
+        "tab" {
+            set part_winactive [tabs_add -path_father $path_father -address $address]
+        }
+        "model" {
+            set part_winactive [modelframe_create -path_father $path_father -address $address -style $part_style]
+        }
+        "multiple" {
+            set part_winactive [multiple_create -path_father $path_father -address $address]
+        }
+        "xor" {
+            set part_winactive [modelxor_create -path_father $path_father -address $address -style $part_style]
+        }
+        "action" {
+            set part_winactive [action_create -path_father $path_father -address $address -style $part_style]
+        }
+        "info" {
+            set part_winactive [info_create -path_father $path_father -address $address]
+        }
+        "choice" {
+            set part_winactive [choice_create -path_father $path_father -address $address]
+        }
+        "comment" {
+            set part_winactive [comment_create -path_father $path_father -address $address]
+        }
+        "comparator" {
+            set part_winactive [comparator_create -path_father $path_father -address $address]
+        }
+        "status" {
+            set part_winactive [status_create -path_father $path_father -address $address]
+        }
+        "graph" {
+            set part_winactive [graph_create -path_father $path_father -address $address]
+        }
+        "glance" {
+            set part_winactive [glance_create -path_father $path_father -address $address]
+        }
+        "timeline" {
+            set part_winactive [timeline_create -path_father $path_father -address $address]
+        }
+        "option" {
+            set part_winactive [choice_add -path_father $path_father -address $address]
+        }
+        "param" {
+            set param_type [dTree_getAttribute $XMLtree  $full_address_XML "type"]
+            
+            switch -glob $param_type {
+                "onoff" {
+                    set part_winactive [switch_create -path_father $path_father -address $address]
+                }
+                "double*" -
+                "integer*" -
+                "fraction" -
+                "date" -
+                "complex" -
+                "string*" -
+                "ascii*" -
+                "vector" -
+                "liststring" {
+                    set part_winactive [entry_create -path_father $path_father -address $address]
+                }
+                "list_*" {
+                    set part_winactive [cluster_create -path_father $path_father -address $address]
+                }
+                "selection" {
+                    set part_winactive [selection_create -path_father $path_father -address $address]
+                }
+                "file" -
+                "multiple_files" -
+                "h5_asciiBound" -
+                "folder" {
+                    set part_winactive [browser_create -path_father $path_father -address $address]
+                }
+                "speccompo" {
+                    error "speccompo is not supported anymore"
+                 #   set part_winactive [speccompo_create -path_father $path_father -address $address]
+                }
+                "labelimage" {
+                    error "labelimage is not supported anymore"
+                    #set part_winactive [labelimage_create -path_father $path_father -address $address]
+                }
+                default {
+                    set widget_title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+                    set widget_status "GuiInfo($address-valid)"
+                    set $widget_status 0
+            
+                    set part_winactive  $path_father.$node_XML
+                    ttk::label $part_winactive -text "$widget_title ($param_type)"
+                    pack $part_winactive
+                }
+            }
+        }
+        "viewer" {
+            set part_winactive [viewer_create -path_father $path_father -address $address]
+        }
+        default {
+            if {$part_class in $additionalWidgets} {
+                set part_winactive [$part_class\_create -path_father $path_father -address $address]
+            } else {
+                debug "part_class Unknown : $part_class ; $address"
+                set part_winactive "unknown"
+            }
+        }
+    }
+    
+    # recursive GUI generation
+    
+    set GuiInfo($address-children) [dTree_getChildren $XMLtree $full_address_XML]
+    
+    set sortedChildren ""
+    set childrenAndOrder ""
+    
+    ######## Sort the children according to their "order" attribute
+    
+    # First, get children and associated orders
+    foreach child $GuiInfo($address-children) {
+        set order "0"
+        set childAndOrder ""
+        # Retrieve order from attributes of the child
+        set order [dTree_tryGetAttribute $XMLtree "$full_address_XML $child" order "9999"]
+        lappend childAndOrder $order
+        lappend childAndOrder $child
+        lappend childrenAndOrder $childAndOrder
+    }
+    
+    # Then, sort
+    set childrenAndOrder [lsort -index 0 -integer $childrenAndOrder]
+    
+    # Finally, store them
+    foreach child $childrenAndOrder {
+        lappend sortedChildren [lindex $child 1]
+    }
+    
+    set GuiInfo($address-children) $sortedChildren
+    
+    if {$part_class != "xor" && $part_class != "multiple"  && $part_class != "choice"} {
+        foreach child $GuiInfo($address-children) {
+            # Case of ";" type nodes (options)
+            if {[string match "*;*" $child]} {
+                set XML_node_address_child "$full_address_XML \{$child\}"
+            } else {
+                set XML_node_address_child [concat $full_address_XML $child]
+            }
+            
+            if {[catch {set widget_child_class "[dTree_getAttribute $XMLtree $XML_node_address_child nodeType]"}]} {
+                warning "WARNING : $XML_node_address_child doesn't have a node type ...\n Setting it to container ..."
+                set widget_child_class "container"
+            }
+            gui_addpart -address $address.$child  -path_father $part_winactive -class $widget_child_class
+        }
+    }
+    
+    
+    return $part_winactive
+}
+
+
+
+
+proc gui_destroy {win} {
+    global GuiInfo
+    foreach item [array names GuiInfo "$win-*"] {
+        unset GuiInfo($item)
+    }
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_info.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_info.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_info.tcl	(revision 4775)
@@ -0,0 +1,120 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc info_create { args } {
+    set mandatory_arguments { path_father address }
+    initWidget
+    
+    
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-status_txt) ""
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    set widgetInfo($address-type) [dTree_tryGetAttribute $XMLtree $full_address_XML "type" "string"]
+    set widgetInfo($address-visibility) [dTree_tryGetAttribute $XMLtree $full_address_XML "visibility" "visible"]
+    
+    ttk::frame $win
+    
+    
+    
+    
+    
+    ttk::label $win.title  -text $title -style "Multiple.TLabel" 
+    
+    switch $widgetInfo($address-type) {
+        "liststring" {
+            ttk::frame $win.result
+            listbox $win.result.lb -listvariable widgetInfo($address-content) -yscrollcommand [list $win.result.sby set] -height 5 -activestyle none -state disabled -background [ThemeColor 1.0]
+              # avoid tab scrolling for mousewheel
+            bind $win.result.lb <MouseWheel> {+set tabscroll 0}
+            bind $win.result.lb  <Leave> {+set tabscroll 1}            
+            
+            ttk::scrollbar $win.result.sby -orient vertical -command [list $win.result.lb yview]
+            grid $win.result.lb -sticky news -column 0 -row 0
+            grid $win.result.sby -sticky news -column 1 -row 0
+            # avoid tab scrolling for mousewheel
+            bind $win.result.sby <MouseWheel> {+set tabscroll 0}
+            bind $win.result.sby <Leave> {+set tabscroll 1}
+        }
+        default {
+            ttk::label $win.result -textvariable widgetInfo($address-variable) -relief sunken -wraplength $widgetInfo(guiSmallWidgetWidth)
+        }
+    }
+    
+    #ttk::label $win.status -textvariable widgetInfo($address-status_txt) -foreground  red
+   
+    if {$widgetInfo($address-visibility) != "hidden"} {
+        eval $widgetInfo(packme-$win)
+       
+    } else {   
+        set widgetInfo(packme-$win) ""
+        eval $widgetInfo(packme-$win)
+    }
+    pack $win.title -side top
+    pack $win.result -side top
+    
+    
+    append widgetInfo($address-refresh) [subst { info_refresh $win $address }]
+    append widgetInfo($address-check) [ subst {  info_check $win $address }]
+    
+    finishWidget
+    
+   
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc info_check {win address} {
+    global widgetInfo
+    
+    if {$widgetInfo($address-type) == "liststring"} {
+        set widgetInfo($address-variable) [join $widgetInfo($address-content) ";"]
+    }
+}
+
+proc info_refresh {win address} {
+    global widgetInfo
+    if {$widgetInfo($address-type) == "liststring"} {
+        set widgetInfo($address-content) [split $widgetInfo($address-variable) ";"]
+    }
+}
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_main.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_main.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_main.tcl	(revision 4775)
@@ -0,0 +1,143 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+# fenetre d'accueil si aucune application n'est choisie au lancement.
+
+proc main_create {} {
+    global pathEngine libraryPath applicationList relaunchCmd configPath
+    
+    wm geometry . 640x640
+        
+    # Get the recent projects 
+    set recents [getRecentProjects] 
+       
+    ttk::frame .main
+    pack .main -fill both -expand true
+    
+    ttk::frame .main.header
+    place  .main.header -relx 0.05 -rely 0.0 -relwidth 0.9 -relheight 0.2
+    
+    
+    ttk::label .main.header.icon -image icon_gui_small
+    
+    wm iconphoto .  icon_gui_small
+    pack .main.header.icon     
+
+   
+    
+    # applications
+    ttk::labelframe .main.app -text "Applications"
+    
+    
+    #pack .main.app  -fill both -expand true
+    place  .main.app -relx 0.05 -rely 0.3 -relwidth 0.9 -relheight 0.65
+    
+    canvas .main.app.c  -yscrollcommand [list .main.app.sby set] -xscrollcommand [list .main.app.sbx set] -background [ThemeColor 1.0] -highlightbackground [ThemeColor 1.0]
+    ttk::scrollbar .main.app.sbx -orient horizontal -command [list .main.app.c xview]
+    ttk::scrollbar .main.app.sby -orient vertical -command [list .main.app.c yview]
+    #grid .main.app.c -row 0 -column 0 
+    #grid .main.app.sby -row 0 -column 1 -sticky news
+    #grid .main.app.sbx -row 1 -column 0 -sticky news
+    
+    place  .main.app.c -relx 0 -rely 0 -relwidth 0.95 -relheight 0.95
+    place  .main.app.sby -relx 0.95 -rely 0  -relheight 0.95
+    place  .main.app.sbx -relx 0 -rely 0.95  -relwidth 0.95 
+    
+    
+    ttk::frame .main.app.c.f
+    .main.app.c  create window 1 1 -window .main.app.c.f
+    
+    #pack .main.app.c.f
+    
+    set win ".main.app.c.f"
+    
+    
+    
+    
+    set colmax 3
+    set colid 0
+    set rowid 0
+    set appid 0
+  
+    foreach app $applicationList {
+        if {$app == "config"} {continue}
+        if {$colid > $colmax } {
+            set colid 0
+            incr rowid  2      
+        }
+        set winref "appico_$appid"
+        
+        
+        set filename [file join $libraryPath $app XML icon.gif]
+        if {[ file exists $filename]} {
+            image create photo icon_$winref -file $filename        
+            ttk::label $win.$winref -image  icon_$winref 
+            grid $win.$winref -column $colid -row $rowid -padx 10 -pady {10 0}
+            set cmd "$relaunchCmd -code $app &"
+            bind $win.$winref <ButtonPress-1>  [subst {
+                puts "Executing $cmd"
+                exec $cmd
+                exit
+            }]
+        }
+            
+        set winref "applbl_$appid"
+        ttk::label $win.$winref -text $app
+        set cmd "$relaunchCmd -code $app &"
+        bind $win.$winref <ButtonPress-1>  [subst {
+            puts "Executing $cmd"
+            exec $cmd
+            exit
+        }]
+        grid $win.$winref -column $colid -row [expr $rowid + 1] -padx 10 -pady {0 10}
+        
+        
+        incr appid
+        incr colid
+    }
+    
+    
+    
+    bind .main.app.c <Configure> [subst {
+        .main.app.c configure -scrollregion \[ .main.app.c bbox all\]
+        .main.app.c xview moveto 0.0
+        .main.app.c yview moveto 0.0
+    }]
+    
+  
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_metaTree.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_metaTree.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_metaTree.tcl	(revision 4775)
@@ -0,0 +1,84 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc fill_metaTree { } {
+    uplevel 1 {} {
+    global loadApplication relaunchCmd pluginsPath libraryPath configPath
+        
+        
+    dTree_init metaTree
+        
+    dTree_addNode metaTree "root" "meta"
+    
+    # SOLVER INFORMATION
+    dTree_addNode metaTree "root meta" "solver"
+    dTree_addNode metaTree "root meta solver" "name" 
+    dTree_setAttribute metaTree "root meta solver name" "value" "$loadApplication"
+    
+    #PROJECT INFORMATION (initialization)
+    dTree_addNode metaTree "root meta" "project"
+    dTree_addNode metaTree "root meta project" "name"    
+    dTree_setAttribute metaTree "root meta project name" "value" "undefined"        
+    dTree_addNode metaTree "root meta project" "address"    
+    dTree_setAttribute metaTree "root meta project address" "value" "undefined"
+
+    # USER INFORMATION
+    dTree_addNode metaTree "root meta project" "username"
+    set username [ getConfig "config id user name"]
+    dTree_setAttribute metaTree "root meta project username" "value" $username
+    dTree_addNode metaTree "root meta project" "company"
+    set company [ getConfig "config id user company"]
+    dTree_setAttribute metaTree "root meta project company" "value" $company
+
+    # INFORMATIONS FOR SCRIPT EXECUTION
+    dTree_addNode metaTree "root meta" "action"
+    dTree_addNode metaTree "root meta action" "callingAddress"
+    dTree_addNode metaTree "root meta" "temporary"
+    dTree_addNode metaTree "root meta" "scriptSuccess"    
+    dTree_addNode metaTree "root meta" "engine"
+    dTree_addNode metaTree "root meta engine" "name"
+    dTree_setAttribute metaTree "root meta engine name" "value" "OpenTEA"
+    dTree_addNode metaTree "root meta engine" "launchCommand"
+    dTree_setAttribute metaTree "root meta engine launchCommand" "value" "$relaunchCmd"
+    dTree_addNode metaTree "root meta engine" "pluginsPath"
+    dTree_setAttribute metaTree "root meta engine pluginsPath" "value" "$pluginsPath"
+    dTree_addNode metaTree "root meta engine" "libraryPath"
+    dTree_setAttribute metaTree "root meta engine libraryPath" "value" "$libraryPath"
+    dTree_addNode metaTree "root meta engine" "configPath"
+    dTree_setAttribute metaTree "root meta engine configPath" "value" "$configPath"
+    
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelframe.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelframe.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelframe.tcl	(revision 4775)
@@ -0,0 +1,84 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+#####################
+# create a 'float' container able to display
+# several parameters and some help
+# the validity status could be shown, but is not
+# displayed for the moment to reduce the number
+# of informations for the user.
+#####################
+
+proc modelframe_create { args } {
+    
+    set mandatory_arguments { path_father address style}
+    initWidget
+    
+    set widgetInfo($address-status) 1
+    
+    set style [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "layout" $style]
+    
+    
+    smartpacker_setup_modelframe $win $address
+    
+   
+    
+    finishWidget    
+    append widgetInfo($address-refreshStatus) [ subst { modelframe_refreshStatus $win $address}]    
+    
+    
+    help_add_desc_docu_to_widget
+    
+    
+    
+    
+    if {$style == "onrequest"} {
+        return $win.snap
+    } else {
+        return $win
+    }
+    
+}
+
+
+# existif behavior
+proc modelframe_refreshStatus {win address} {
+    global widgetInfo
+    smartpacker_update_visibility $win $address
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor.tcl	(revision 4775)
@@ -0,0 +1,213 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+# create the frame in wich an exclusive selection of model wil be done
+# create the menubutton used for selection
+proc modelxor_create { args } {
+
+    set mandatory_arguments {path_father address}
+
+    # Initializes the widget
+    initWidget
+    
+    smartpacker_setup_modelframe $win $address
+    
+    # the  menubutton seclector
+    ttk::menubutton $win.mb -menu $win.mb.xor -textvariable widgetInfo($address-variable_title) 
+    menu $win.mb.xor -tearoff 0 
+    pack $win.mb
+
+    # this frame is where all xor choices will be used
+    switchform_create $win.xor
+    
+    if  {[dTree_attrExists $XMLtree $full_address_XML "groups"]==1} {
+            set widgetInfo($address-groups) 1            
+    } else {
+            set widgetInfo($address-groups) 0
+    }    
+    
+    set widgetInfo($address-full_address_XML_clean) $full_address_XML_clean
+    set widgetInfo($address-children) [dTree_getChildren_fast $XMLtree $full_address_XML_clean ]
+    
+    
+    set main_menu_reduced ""
+    # find the redondant childs in the menu and gather , if groups are enabled
+    if {$widgetInfo($address-groups)} {
+        set main_menu ""
+        foreach child $widgetInfo($address-children) {
+            lappend main_menu [lindex [split $child "_"] 0]
+        }
+        foreach category  $main_menu {
+            set items [llength [lsearch -all $main_menu $category] ]
+            if {$items > 1} {
+                lappend main_menu_reduced $category
+            }
+        }
+        set main_menu_reduced [lsort -unique $main_menu_reduced]
+    }    
+    
+    set widgetInfo($address-categories) $main_menu_reduced
+    
+    
+    
+    # add the groups (if any)
+    set widgetInfo($address-catindex-none) 0
+    foreach category  $main_menu_reduced {
+        menu $win.mb.xor.$category -tearoff 0 
+        $win.mb.xor add cascade -menu $win.mb.xor.$category  -label "[string totitle $category]"
+        set widgetInfo($address-catindex-$category) 0
+        set widgetInfo($address-catchildren-$category) ""
+    }
+    
+    
+    
+    foreach child $widgetInfo($address-children) {
+        set title [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "title"]
+        set child_nodeType [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "nodeType"]
+        switchform_add  $win.xor $child
+        gui_addpart -address $address.$child  -path_father $win.xor.$child -class $child_nodeType -style "flat"
+        
+        
+        # add the command either at the root or in the groups
+        set category [lindex [split $child "_"] 0]
+        if {[lsearch $widgetInfo($address-categories) $category] ==-1 } {
+            $win.mb.xor add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }]
+            set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-none)
+            set widgetInfo($address-childmenu-$child) $win.mb.xor
+            set widgetInfo($address-childcategory-$child) "none"
+            lappend widgetInfo($address-catchildren-none) $child
+            incr widgetInfo($address-catindex-none) 1
+        } else {
+            $win.mb.xor.$category add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }]
+            set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-$category)
+            set widgetInfo($address-childmenu-$child) $win.mb.xor.$category
+            set widgetInfo($address-childcategory-$child) "$category"
+            lappend widgetInfo($address-catchildren-$category) $child
+            incr widgetInfo($address-catindex-$category) 1
+        }
+    }
+    
+    # Finishes the widget
+    # append widgetInfo($address-check) [ subst {modelxor_check $win $address}]
+    append widgetInfo($address-refreshStatus) [ subst {modelxor_refreshStatus $win $address}]
+    
+    finishWidget
+    
+    help_add_desc_docu_to_widget
+    
+    # initialize the layout by the default 
+    modelxor_mb_action $win $address $widgetInfo($address-variable)
+    
+    
+   # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]    
+    
+    return $win 
+}
+
+
+proc modelxor_mb_action { win address child } {
+    global widgetInfo XMLtree tmpTree 
+
+    # if this model is not available, switch to the previous.
+    # set child_address "$address.$widgetInfo($address-variable)"
+
+    # update the value
+    if { $widgetInfo($address-variable) != $child} {        
+        set widgetInfo($address-variable) $child
+        eval $widgetInfo($address-check)
+    }
+}
+
+proc modelxor_refreshStatus {win address} {
+    global widgetInfo XMLtree
+    
+     if {$widgetInfo($address-variable)!=""} {
+        #puts "$widgetInfo($address-variable)  and $widgetInfo($address-children)"
+        # check if this child exist , if not move to the first availble
+        if {$widgetInfo($address-variable) in $widgetInfo($address-children)} {
+                # nothin to do, all okk
+        } else {
+                warning "found $widgetInfo($address-variable) , which is not one of $widgetInfo($address-children). Please check your setup "
+                set widgetInfo($address-variable) [lindex $widgetInfo($address-children) 0]
+        }
+        
+        switchform_raise $win.xor $widgetInfo($address-variable)
+        set widgetInfo($address-variable_title) [dTree_getAttribute_fast $XMLtree "$widgetInfo($address-full_address_XML_clean) $widgetInfo($address-variable)" "title"]
+     }
+     
+     
+     # update the drop-down list
+     foreach child $widgetInfo($address-children) {
+         if {$widgetInfo($address.$child-visible)==0} {
+             $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state disabled
+         } else {
+             $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state normal
+         }
+     }
+     
+     # move to the first visible children if needed 
+     set child_address "$address.$widgetInfo($address-variable)"
+     
+     # must be initialized in case of a change in the XML (new xor)
+     if {[info exists widgetInfo($child_address-visible)] == 0} {
+        set widgetInfo($child_address-visible) 0
+        puts ">>> modelxor_refreshstatus initialisation of visibility"
+     }
+     
+     if {$widgetInfo($child_address-visible)==0} {
+         set index 0
+         set found 0
+         foreach child $widgetInfo($address-catchildren-$widgetInfo($address-childcategory-$child)) {
+             if {$widgetInfo($address.$child-visible)==1} {
+                 set found 1
+                 $widgetInfo($address-childmenu-$child) invoke $index
+             }
+             if {$found} {
+                 break
+             }
+             incr index
+         }
+         if {$found == 0} {
+             warning "Error in the XML library for the model:\n $address \n existif declarations allowed a dead end. "
+         }
+     }
+     smartpacker_update_visibility $win $address
+}
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor_light.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor_light.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_modelxor_light.tcl	(revision 4775)
@@ -0,0 +1,292 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+# create the frame in wich an exclusive selection of model wil be done
+# create the menubutton used for selection
+proc modelxor_create { args } {
+
+    set mandatory_arguments {path_father address}
+
+    # Initializes the widget
+    initWidget
+    
+    smartpacker_setup_modelframe $win $address
+    
+    set widgetInfo($address-to_reset) 0
+    
+    set widgetInfo($address-status) 0
+    set widgetInfo($address-dependencies_status) 1
+    
+	set widgetInfo($address-status_txt) ""
+	ttk::label $win.status -textvariable widgetInfo($address-status_txt) -foreground "red" -justify center -compound left
+	# the  menubutton seclector
+    ttk::menubutton $win.mb -menu $win.mb.xor -textvariable widgetInfo($address-variable_title) 
+    menu $win.mb.xor -tearoff 0 -postcommand [subst { modelxor_mb_refresh $win $address}]
+    pack $win.mb
+    pack $win.status
+
+    # this frame is where all xor choices will be used
+    #switchform_create $win.xor
+    ttk::frame $win.xor
+    pack $win.xor -side top -expand 1 -fill both
+    
+    
+    
+    if  {[dTree_attrExists $XMLtree $full_address_XML "groups"]==1} {
+            set widgetInfo($address-groups) 1            
+    } else {
+            set widgetInfo($address-groups) 0
+    }    
+    
+    
+    set widgetInfo($address-full_address_XML_clean) $full_address_XML_clean
+    set widgetInfo($address-children) [dTree_getChildren_fast $XMLtree $full_address_XML_clean ]
+    
+    
+    set main_menu_reduced ""
+    # find the redondant childs in the menu and gather , if groups are enabled
+    if {$widgetInfo($address-groups)} {
+        set main_menu ""
+        foreach child $widgetInfo($address-children) {
+            lappend main_menu [lindex [split $child "_"] 0]
+        }
+        foreach category  $main_menu {
+            set items [llength [lsearch -all $main_menu $category] ]
+            if {$items > 1} {
+                lappend main_menu_reduced $category
+            }
+        }
+        set main_menu_reduced [lsort -unique $main_menu_reduced]
+    }    
+    
+    set widgetInfo($address-categories) $main_menu_reduced
+    
+    
+    
+    # add the groups (if any)
+    set widgetInfo($address-catindex-none) 0
+    foreach category  $main_menu_reduced {
+        menu $win.mb.xor.$category -tearoff 0 
+        $win.mb.xor add cascade -menu $win.mb.xor.$category  -label "[string totitle $category]"
+        set widgetInfo($address-catindex-$category) 0
+        set widgetInfo($address-catchildren-$category) ""
+    }
+    
+    
+    set widgetInfo($address-child-conditional) ""
+    
+    foreach child $widgetInfo($address-children) {
+        
+        set title [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "title"]
+        set child_nodeType [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "nodeType"]
+        if {[dTree_attrExists $XMLtree "$full_address_XML_clean $child" "existif"] ==1 } {
+            lappend widgetInfo($address-child-conditional) $child
+            bind . <<visiblityChanged-$address.$child>> +[subst { eval modelxor_updatechoice_from_existifs $win $address}]
+        }
+        
+        
+        
+        # add the command either at the root or in the groups
+        set category [lindex [split $child "_"] 0]
+        if {[lsearch $widgetInfo($address-categories) $category] ==-1 } {
+            $win.mb.xor add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }] 
+            set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-none)
+            set widgetInfo($address-childmenu-$child) $win.mb.xor
+            set widgetInfo($address-childcategory-$child) "none"
+            lappend widgetInfo($address-catchildren-none) $child
+            incr widgetInfo($address-catindex-none) 1
+        } else {
+            $win.mb.xor.$category add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }]
+            set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-$category)
+            set widgetInfo($address-childmenu-$child) $win.mb.xor.$category
+            set widgetInfo($address-childcategory-$child) "$category"
+            lappend widgetInfo($address-catchildren-$category) $child
+            incr widgetInfo($address-catindex-$category) 1
+        }
+    }
+    
+    # Finishes the widget
+    # append widgetInfo($address-check) [ subst {modelxor_check $win $address}]
+    append widgetInfo($address-refreshStatus) [ subst {modelxor_refreshStatus $win $address}]
+    
+    finishWidget
+    
+    help_add_desc_docu_to_widget
+    
+    # initialize the layout by the default 
+    modelxor_mb_action $win $address $widgetInfo($address-variable)
+    
+    
+   # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]    
+    
+    return $win 
+}
+
+proc modelxor_mb_refresh {win address} {
+    global widgetInfo XMLtree tmpTree
+    
+    set full_address_XML_clean $widgetInfo($address-full_address_XML_clean)
+    # Updates of existifs in the menu
+    foreach child $widgetInfo($address-child-conditional) {
+        set existifArg [build_existIf_argument "$full_address_XML_clean $child"]
+        set existIfArgument [join [lindex $existifArg 0] " "]
+        if {[expr $existIfArgument]} {
+            $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state normal
+            lappend child_authorized $child
+        } else {
+            $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state disabled    
+        }        
+    }
+   
+}
+
+
+
+proc modelxor_mb_action { win address setchild } {
+    global widgetInfo XMLtree tmpTree
+    
+    
+    # update the value
+    if { $widgetInfo($address-variable) != $setchild} {        
+        set widgetInfo($address-variable) $setchild
+        eval $widgetInfo($address-check)
+    }
+    
+}
+
+
+proc modelxor_updatechoice_from_existifs {win address} {
+    global widgetInfo
+    
+    set initStatus $widgetInfo($address-status)
+    set widgetInfo($address-dependencies_status) "1"
+    
+    
+    
+          
+    set child $widgetInfo($address-variable)
+    if { $child in $widgetInfo($address-child-conditional) } {    
+        if {$widgetInfo($address.$child-visible) == 0 } {
+            warning "XOR $address cannot keep $widgetInfo($address-variable)"
+            
+            set widgetInfo($address-dependencies_status)  "-1"
+            $win.status configure -image icon_flag
+            set widgetInfo($address-status_txt) "$widgetInfo($address-variable) is not a possible choice"
+        } 
+    }
+    
+    set widgetInfo($address-status) [expr min($widgetInfo($address-status),$widgetInfo($address-dependencies_status)) ]
+    
+    # commented for the moment. Might be a need.
+    #if {$initStatus != $widgetInfo($address-status)} {
+        #UpdateValidationStatus $address
+    #}
+}
+
+
+proc modelxor_refreshStatus {win address} {
+    global widgetInfo XMLtree tmpTree
+    
+    set full_address_XML_clean $widgetInfo($address-full_address_XML_clean)
+    
+    set widgetInfo($address-status_txt) ""
+    $win.status configure -image ""
+    
+    
+    #  l'enfant actuellement affiche
+    set currentchild [lindex [split [winfo children $win.xor] "."] end ]
+    
+    # l'enfant qu'il faudrait afficher
+    set child $widgetInfo($address-variable)
+    
+    
+    
+    set refreshxor 0
+    # si l'enfant actuellemnt affiche n'est pas le bon
+    if {$currentchild != $child } {
+        modelxor_killchild $win $address $currentchild
+        set refreshxor 1
+    }
+    # si il faut reinitialiser l'onglet            
+    if {$widgetInfo($address-to_reset) == 1} {
+        #debug ">>>> reinit $address.$child "
+        destroy $win.xor.$child
+        set refreshxor 1
+        set widgetInfo($address-to_reset) 0
+    }
+    
+    
+    # create new memory and gui
+    if {   $refreshxor == 1} {
+        #debug ">>>> creating $address.$child "
+        set winchild $win.xor.$child
+        ttk::frame $winchild
+        pack $winchild -side top -expand 1 -fill both
+        set child_nodeType [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "nodeType"]
+        set newpart [gui_addpart -address $address.$child  -path_father $winchild -class $child_nodeType -style "flat"]    
+        CheckFamily  $address.$child
+    }
+    
+    
+    set widgetInfo($address-variable_title) [dTree_getAttribute_fast $XMLtree "$widgetInfo($address-full_address_XML_clean) $widgetInfo($address-variable)" "title"]
+        
+    smartpacker_update_visibility $win $address
+    modelxor_updatechoice_from_existifs $win $address
+    
+   
+
+}
+
+proc modelxor_killchild {win address child} {
+    global widgetInfo
+    global tmpTree
+    if {$child  ==""} {return}
+    
+    #debug ">>>>  killing $address.$child"
+    destroy $win.xor.$child
+    # clean widget info
+    array unset widgetInfo $address.$child\*
+    # destroy tmptree information
+    set full_address_XML [split $address.$child "."]
+    if {[dTree_nodeExists $tmpTree $full_address_XML]} {
+        dTree_rmBranch tmpTree $full_address_XML
+    }
+    return
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_multiple.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_multiple.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_multiple.tcl	(revision 4775)
@@ -0,0 +1,985 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc multiple_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget
+
+    
+    set widgetInfo($address-listChildren) [dTree_getChildren_fast $XMLtree $full_address_XML_clean ]
+    set widgetInfo($address-renaming) 0
+    set widgetInfo($address-content) ""
+    set widgetInfo($address-name) $name
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-status_txt) ""
+    set widgetInfo($address-copy) "none"
+    set widgetInfo($address-copied) ""
+    set widgetInfo($address-lastclick) [clock milliseconds]
+    
+    set widgetInfo($address-full_address_XML_clean) $full_address_XML_clean
+    set widgetInfo($address-full_address_XML) $full_address_XML
+    
+    
+    if  {[dTree_attrExists $XMLtree $full_address_XML_clean "require"]==1} {
+        set widgetInfo($address-multiplemode) "require"
+    } else {
+        set widgetInfo($address-multiplemode) "independant"
+    }
+    
+    set size_v 10
+    set size_h 1.
+    set size [split [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "size" "1;1" ] ";"]
+    set size_h [expr {[lindex $size 1]*1.*$size_h}]
+    set size_v [expr {int([lindex $size 1]*1.*$size_v)}]
+
+    set subcolumns  [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "subcolumns" "1"]  
+    set widgetInfo($address-subcolumns) $subcolumns
+    
+    set label_name [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "custom_label" "Label"]  
+
+    ###############
+    # MAIN FRAMES #
+    ###############
+    
+    ttk::frame $win 
+    ttk::frame $win.forceps -width $widgetInfo(guiBigWidgetWidth) -height 0 
+    ttk::frame $win.ftv -relief groove -borderwidth 2   
+    ttk::frame $win.children -relief groove -borderwidth 2
+    ttk::frame $win.children.forceps -width [expr {int($subcolumns*$widgetInfo(guiSmallWidgetWidth))}] -height 0     
+    switchform_create $win.children.flipbook
+      
+      
+      
+    eval $widgetInfo(packme-$win)
+    pack $win.forceps -side top
+    help_add_desc_docu_to_widget
+    
+    switch $widgetInfo(guimode) {
+        "treeview" {
+           pack $win.ftv -fill both -side top -expand 1 
+        }
+        "multicolumn" {
+          pack $win.ftv -fill both -side left -expand 1 
+        }
+    }
+    pack $win.children -in $win -fill both -side top -expand 1 
+    pack $win.children.forceps -side top
+    
+    ############
+    # TREEVIEW #
+    ############
+    
+    set title [dTree_getAttribute_fast $XMLtree $full_address_XML_clean "title"]   
+    #ttk::label $win.ftv.lb -text $title -style "Multiple.TLabel"
+    
+    ttk::treeview $win.ftv.tv -selectmode browse -show { headings} -yscrollcommand [list $win.ftv.sby set] -height 15
+    # paint upon background tags
+    $win.ftv.tv tag configure false -background #ff5050
+    $win.ftv.tv tag configure unknown -background #ffcd7c
+    $win.ftv.tv tag configure true -background ""
+    #-xscrollcommand [list $win.ftv.sbx set]
+    # create the columns of the treeview    
+    set widgetInfo($address-listChildren) [dTree_getChildren_fast $XMLtree "$full_address_XML_clean item" ]
+    
+    set ncols [expr {1+[llength $widgetInfo($address-listChildren)]}]
+    
+    set columns_labels "lbl"
+    set visible_cols 1
+    foreach child $widgetInfo($address-listChildren) {
+        
+        set child_visible [dTree_tryGetAttribute $XMLtree "$full_address_XML_clean item $child" "visibility"  ""]
+        if {$child_visible in "hidden not_in_table"} {
+           # pass
+        } else {
+           incr visible_cols
+        }
+        lappend columns_labels $child    
+    }
+    set widgetInfo($address-colwidth) [expr {int([expr {$size_h*1.* $widgetInfo(guiSmallWidgetWidth)/$visible_cols}])}]
+    $win.ftv.tv configure -columns $columns_labels
+    $win.ftv.tv column #1 -width $widgetInfo($address-colwidth) 
+    $win.ftv.tv heading lbl -text $label_name -command [subst {multiple_sortrows $win $address #0}]
+    set colid 1
+    
+    foreach child $widgetInfo($address-listChildren) {
+        incr colid
+        set child_title [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean item $child" "title"]
+        set child_visible [dTree_tryGetAttribute $XMLtree "$full_address_XML_clean item $child" "visibility"  ""]    
+       
+            
+        if {$child_visible in "hidden not_in_table"} {
+            $win.ftv.tv column #$colid -width 0 -minwidth 0 -anchor s
+            $win.ftv.tv heading $child -text "" 
+        } else {
+            $win.ftv.tv column #$colid -width $widgetInfo($address-colwidth) 
+            $win.ftv.tv heading $child -text "$child_title" -command [subst {multiple_sortrows $win $address #$colid}]
+        }
+        
+    }        
+    
+    ttk::scrollbar $win.ftv.sby -orient vertical -command [list $win.ftv.tv yview]
+    
+    # avoid tab scrolling for mousewheel
+    #bind $win.ftv.tv <MouseWheel> {+set tabscroll 0}
+    #bind $win.ftv.tv  <Leave> {+set tabscroll 1}
+    
+    
+    #ttk::scrollbar $win.ftv.sbx -orient horizontal -command [list $win.ftv.tv xview]
+    
+    #grid $win.ftv.lb -sticky w -column 0 -row 0
+    grid $win.ftv.tv -sticky news -column 0 -row 2 
+    grid $win.ftv.sby -sticky news -column 1 -row 2
+    #grid $win.ftv.sbx -sticky news -column 0 -row 3
+    
+
+    
+    
+    ############
+    # CONTROLS #
+    ############
+    ttk::frame $win.ftv.controls
+    grid $win.ftv.controls -sticky news -column 0 -row 4
+    ttk::label $win.ftv.controls.status -textvariable widgetInfo($address-status_txt) -foreground "red" -justify left -compound left
+    pack $win.ftv.controls.status -side bottom 
+    
+    
+    #icons with buttons
+    ttk::button $win.ftv.controls.add -text "add $title" -compound left -command [subst {
+        set newSelItem  \[multiple_ctrl_addchild $win $address\]
+        eval \$widgetInfo($address-check)
+        $win.ftv.tv selection set \$newSelItem
+        multiple_rename $win $address  \$newSelItem #1
+    }]
+    balloon $win.ftv.controls.add  "Add a new row, after the row selected if any"
+    
+    ttk::button $win.ftv.controls.rm  -text "del $title"  -compound left -command [subst {
+        set newSelItem \[multiple_ctrl_rmchild $win $address\] 
+        eval \$widgetInfo($address-check)
+    }]
+    balloon $win.ftv.controls.rm  "Remove the selected  row."
+    
+    ttk::button $win.ftv.controls.copy -text "copy selection" -command [subst {
+        multiple_ctrl_copychild $win $address
+        #eval \$widgetInfo($address-check)   
+    }]
+    balloon $win.ftv.controls.copy  "First, select a row. Hit this \"Copy\" button. Select all rows where you want to paste."
+    
+    
+    ttk::button $win.ftv.controls.load -text "load" -command [subst {
+        multiple_ctrl_loadfromproject $win $address
+       
+    }]      
+    
+    
+    if {$widgetInfo($address-multiplemode)=="independant"} {
+       pack $win.ftv.controls.add $win.ftv.controls.rm -side left -anchor nw -padx 0 -pady 0      
+    }
+    
+    pack   $win.ftv.controls.copy -side left -anchor nw -padx 0 -pady 0      
+    pack   $win.ftv.controls.load -side left -anchor nw -padx 0 -pady 0      
+    
+   
+   
+    append widgetInfo($address-refresh) [subst {multiple_refresh $win $address}]
+    append widgetInfo($address-check) [subst { multiple_check $win $address}]
+    append widgetInfo($address-refreshStatus) [subst {multiple_refreshStatus $win $address}]
+    
+    
+    finishWidget
+    
+    
+
+    
+    # reaction to cells
+    
+    bind $win.ftv.tv <<TreeviewSelect>> +[subst { multiple_sync $win $address "current_selection"}]
+  
+    
+    bind $win.ftv.tv <ButtonPress> [subst {
+                                    multiple_simple_trigger $win $address %x %y
+                                    multiple_trytocopy $win $address %x %y
+                                    }]
+    bind $win.ftv.tv <B1-Motion> [subst { multiple_trytocopy $win $address %x %y}]
+    bind $win.ftv.tv <ButtonRelease> [subst { set widgetInfo($address-copied) "" }]
+    
+    bind $win.ftv <Enter> [subst { set tabscroll 0 }]
+    bind $win.ftv <Leave> [subst {
+        set tabscroll 1
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+        $win.ftv.controls.copy configure -text "copy" -default normal
+        set widgetInfo($address-copy) "none"
+        . config -cursor left_ptr
+    }]
+    
+    
+    set widgetInfo($address-initialized) 0
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win.children
+}
+
+
+# Simple Click : raise the form relative to the child
+proc multiple_simple_trigger {win address x y} {
+    global widgetInfo
+    set row [$win.ftv.tv identify row $x $y]
+    set col [$win.ftv.tv identify column $x $y]
+    
+    set double_click 0
+    set current_time_ms [clock milliseconds]
+    set delay [expr {$current_time_ms - $widgetInfo($address-lastclick)}]
+    set widgetInfo($address-lastclick) $current_time_ms
+    if {$delay <300 } {
+        set double_click 1
+    }
+    
+    
+    if {$row!= ""} {
+        
+        if {$double_click} {
+            switch $col {
+                "#0" {
+                
+                }
+                "#1" {
+                    if {$widgetInfo($address-multiplemode) !="require"} {
+                        multiple_rename $win $address $row $col
+                    }
+                }
+                default {
+                    set child [  $win.ftv.tv column $col -id]
+                    
+                    # case of a menubutton
+                    if {[winfo exists $win.children.flipbook.$row.$child.mb]} {
+                        set winmb $win.children.flipbook.$row.$child.mb
+                        set xmb [winfo rootx $winmb]
+                        set ymb [expr [winfo rooty $winmb] + [winfo height $winmb]]
+                        $win.children.flipbook.$row.$child.mb.xor post $xmb $ymb
+                    }
+                    
+                    # case of a checkbutton
+                    if {[winfo exists $win.children.flipbook.$row.$child.cb]} {
+                        focus $win.children.flipbook.$row.$child.cb
+                        $win.children.flipbook.$row.$child.cb invoke
+                    }
+                    # case of an entry
+                    if {[winfo exists $win.children.flipbook.$row.$child.entry]} {
+                        $win.children.flipbook.$row.$child.entry selection range 0 end
+                        focus $win.children.flipbook.$row.$child.entry 
+                    }               
+                }
+            }
+        }
+    }
+}
+
+
+
+proc multiple_sortrows {win address col} {
+    global widgetInfo 
+    set child  [$win.ftv.tv column $col -id] 
+    set sortlist ""
+    foreach couple $widgetInfo($address-content) {
+        set child_node [lindex $couple 0]
+        set child_label [join [lrange $couple 1 end ]]
+        switch $col {
+            "#0" {
+                set name $child_node
+            }
+            "#1" {
+                set name $widgetInfo($address.$child_node-variable)
+            }
+            default {
+                set child_address "$address.$child_node.$child"
+                set name  $widgetInfo($child_address-variable)
+            }
+        }
+        lappend sortlist "$child_node $name"
+    }
+    set sortlist [lsort -dictionary -decreasing -index 1 $sortlist]
+    #puts "$sortlist"
+    foreach pair $sortlist {
+        $win.ftv.tv move [lindex $pair 0] {} 0
+    }
+
+}
+
+
+
+proc multiple_trytocopy {win address x y} {
+    global widgetInfo tmpTree
+    # exclude if no copy 
+    if {$widgetInfo($address-copy) == "none" } {return}
+    
+    set row [$win.ftv.tv identify row $x $y]
+    
+    # exclude if no target
+    if {$row == ""} {return}
+
+    # exclude if target == source
+    if {$row == $widgetInfo($address-copy)} {return}
+    
+    # exclude if target already copied
+    if {[lsearch $widgetInfo($address-copied) $row ] != -1 } {
+        return
+    } else {
+        lappend widgetInfo($address-copied) $row
+    }
+    
+    # copy
+    set target_address $address.$row
+    set source_address $address.$widgetInfo($address-copy)
+    
+    # copy paste in the tmpTree
+    dTree_duplicateBranch tmpTree [gui2tree $source_address] [gui2tree $target_address]
+    
+    #keep name
+    set name $widgetInfo($target_address-variable)
+    # the the addresses of data to paste
+    set widgetInfo_source_adr [array names widgetInfo $source_address\* ]
+    # clean widget info array before all
+    array unset widgetInfo $target_address\*
+    # get the lenght of the common root in addresses
+    set lroot [string length $source_address ]
+    # loop on the elements to paste
+    foreach element $widgetInfo_source_adr {
+        # trim elements to get only the variable part at the end
+        set element [string range $element $lroot end]
+        # update the content of the element if it involves the name of the paste node
+        regsub -all $widgetInfo($address-copy) $widgetInfo($source_address$element) $row newvalue
+        # paste
+        set widgetInfo($target_address$element) $newvalue
+    }
+    # override the name of the pasted node 
+    set widgetInfo($target_address-variable) $name
+    foreach  xor_former_var_adr [array names widgetInfo "$target_address\*to_reset" ] {
+        set widgetInfo($xor_former_var_adr) 1
+    }
+    
+    # call recursively the check method to update tmpTree (and the gui behind)
+    CheckFamily $target_address
+    
+}
+
+
+# renaming dialog
+proc multiple_rename {win address row col } {
+    global widgetInfo
+    if { $widgetInfo($address-renaming) != 0 } {
+        focus $win.ftv.tv.rename.entry
+        return    
+    }                    
+    
+    set widgetInfo($address-renaming) $row                    
+    set widgetInfo($address-renamingCol) $col 
+    
+    frame $win.ftv.tv.rename -background red  -bd 2
+    set bbox [$win.ftv.tv bbox $row $col]
+    
+    place $win.ftv.tv.rename -x [lindex $bbox 0] -y [lindex $bbox 1] -width [lindex $bbox 2] -height [lindex $bbox 3]
+    
+    
+    focus $win.ftv.tv.rename
+    
+    set widgetInfo($address-entry) [$win.ftv.tv set $row $col]
+    ttk::entry $win.ftv.tv.rename.entry -textvariable widgetInfo($address-entry) 
+    pack $win.ftv.tv.rename.entry -expand 1
+    $win.ftv.tv.rename.entry selection range 0 end
+    $win.ftv.tv.rename.entry icursor end
+    focus $win.ftv.tv.rename.entry
+
+
+    bind $win.ftv.tv.rename.entry <Return>  [ subst {
+        multiple_setname $address $win $row $col
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]
+    
+    
+    bind $win.ftv.tv.rename.entry <FocusOut>  [ subst {
+        multiple_setname $address $win $row $col
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]    
+    
+    bind $win.ftv.tv.rename.entry <Escape>  [ subst {
+        destroy $win.ftv.tv.rename
+        set widgetInfo($address-renaming) 0
+    }]
+}
+
+# change the label assigned 
+proc multiple_setname { address win row col } {
+    global widgetInfo tmpTree
+
+    
+    set current_nodes ""
+    set current_labels ""
+    foreach couple $widgetInfo($address-content) {
+        lappend current_nodes [lindex  $couple 0]
+        lappend current_labels [join [lrange  $couple 1 end]]
+    }                
+    
+    set node_tochange $row
+    set rank_tochange [lsearch $current_nodes $row]
+    set old_label [lindex $current_labels $rank_tochange]
+    set new_label [ stringcleanBalise $widgetInfo($address-entry)]
+    
+    
+    if {$old_label != $new_label} {
+        
+        if { [lsearch $current_labels $new_label]==-1} {
+            # update the content
+            set widgetInfo($address-content) [ lreplace $widgetInfo($address-content) $rank_tochange $rank_tochange "$node_tochange $new_label" ]
+            # update the variable and check
+            set child_address $address.$node_tochange
+            set widgetInfo($child_address-variable)  $new_label
+            eval $widgetInfo($child_address-check)
+            $win.ftv.tv set $row $col $new_label
+    
+        } else {
+            set widgetInfo($address-status_txt) "Label $widgetInfo($address-entry) already in use "
+        }
+    }
+    return
+}
+
+
+# called by the "+" button is invoked
+proc multiple_ctrl_addchild {win address} {
+    global widgetInfo tmpTree
+    
+    set widgetInfo($address-copy)  "off"
+    multiple_ctrl_copychild $win $address
+    
+    set row [$win.ftv.tv selection ]
+    # find where to insert the child         
+    set list_nodes ""
+    foreach couple $widgetInfo($address-content) {
+        lappend list_nodes [lindex $couple 0]
+    }
+    if { $row != "" } {
+        set rank [lsearch $list_nodes $row]
+        incr rank
+        
+    } else {
+        set rank "end"
+        set row 0
+    }
+    set childname [ multiple_new_child $win $address $rank ]
+    
+    return $childname
+}
+
+proc multiple_ctrl_rmchild {win address } {
+    global widgetInfo
+    
+    set widgetInfo($address-copy)  "off"
+    multiple_ctrl_copychild $win $address    
+    
+    set row [$win.ftv.tv selection ]
+    # find where to delete the child
+    set list_nodes ""
+    foreach couple $widgetInfo($address-content) {
+        lappend list_nodes [lindex $couple 0]
+    }
+    if { $row != "" } {
+        set rank [lsearch $list_nodes $row]
+        set newSelItem [lindex $list_nodes [expr {$rank+1}]]
+
+    } else {
+        return
+    }
+    # abort if its the last item
+    #if {[llength "$widgetInfo($address-content)"] == 1 } {return}
+    
+   
+    multiple_del_child $win $address $row
+    return $newSelItem
+}
+
+
+proc multiple_ctrl_copychild {win address } {
+    global widgetInfo
+    
+    
+    switch $widgetInfo($address-copy) {
+        "none" {
+            set source_child [$win.ftv.tv selection ]
+            if {$source_child ==""} {return}
+            set widgetInfo($address-copy) $source_child
+            set source_name $widgetInfo($address.$source_child-variable)
+            $win.ftv.controls.copy configure -text "copying $source_name" -default active
+            . config -cursor spraycan
+            
+        }
+        default {
+            $win.ftv.controls.copy configure -text "copy" -default normal
+            set widgetInfo($address-copy) "none"
+            . config -cursor left_ptr
+            
+        }
+    }
+}
+
+proc multiple_ctrl_loadfromproject {win address } {
+    global widgetInfo DStree tmpTree
+    
+    set filename [tk_getOpenFile -title "Load the \"$widgetInfo($address-name)\" setup of an other project" ]
+    if {$filename == ""} {return}
+    
+    log "Try to load file $filename"
+    dTree_init SourceDStree
+    parseFile $filename SourceDStree "" "DStree"
+    dTree_copyRelevantBranch_ForpartialData SourceDStree [linsert  [gui2tree $address] 1 "dataset" ]  DStree [gui2tree [addrGetFather $address]] 
+    RefreshFamily $address
+    eval $widgetInfo($address-check)   
+}
+
+
+
+# called when :
+# - "+" button is invoked
+# - a new child is needed
+proc multiple_new_child { win address rank  { child_label "none"} } {
+    global widgetInfo
+        
+    #set index [string range [clock clicks] end-6 end]
+    set index [info cmdcount]
+    set child_node "item_$index"
+    # in the case of unknown name
+    if {$child_label=="none"} {
+        #set child_label "$widgetInfo($address-name)_$index"
+        set child_label "no label"
+    }
+    # add to the main multiple widget
+    set widgetInfo($address-content) [ linsert $widgetInfo($address-content) $rank  "$child_node  $child_label"]
+    return $child_node
+}
+
+
+# called when :
+# - "-" button is invoked
+# - a  child must be deleted
+proc multiple_del_child { win address child_node } {
+    global widgetInfo 
+    
+    set list_nodes ""
+    foreach couple $widgetInfo($address-content) {
+        lappend list_nodes [lindex $couple 0]
+    }    
+    set rank [lsearch $list_nodes $child_node]
+    
+    # remove from the main multiple widget
+    set widgetInfo($address-content) [ lreplace $widgetInfo($address-content) $rank $rank  ]
+   
+}
+
+
+
+
+proc multiple_refresh {win address} {
+    global widgetInfo  DStree
+    set content ""
+    
+    
+    
+    # instead of using widgetInfo(variable), this is using the childs, because we want no value in the widget multiple, only childs
+    if {[dTree_nodeExists $DStree $widgetInfo($address-full_address_XML)]} {
+            foreach child [dTree_getChildren_fast $DStree $widgetInfo($address-full_address_XML)] {
+                lappend content [list $child [dTree_getAttribute_fast $DStree "$widgetInfo($address-full_address_XML) $child" "value"]]
+            }
+    }
+    set widgetInfo($address-content) $content      
+    #
+    
+  
+        
+    #add the check/refresh procedure to the bindings of the variable
+    if {$widgetInfo($address-multiplemode) =="require"} {
+        multiple_require $win $address
+    }      
+}
+
+
+
+
+proc multiple_refreshStatus {win address} {
+    global widgetInfo
+    
+    # some reset to kepp the multiple tidy
+    destroy $win.ftv.tv.rename 
+    set widgetInfo($address-renaming) 0
+    
+   
+    set widgetInfo($address-status_txt) ""
+    
+    set current_nodes ""
+    set current_labels ""
+    foreach couple $widgetInfo($address-content) {
+        set node [lindex  $couple 0]
+        set lbl [join [lrange  $couple 1 end]]
+        
+        
+        #set widgetInfo($address.$node-status) 0
+        
+        
+        if {$lbl in $current_labels} {
+            set widgetInfo($address-status_txt) "Some items have the same labels"       
+        }
+        
+        lappend current_nodes $node
+        lappend current_labels $lbl
+        
+        if {$lbl == "no label"} {
+            set widgetInfo($address-status_txt) "Some items have no label"   
+        }
+        
+        
+    }            
+    
+    
+    # Reinitialize the treeview
+    set tvselection [$win.ftv.tv selection]
+    ###############
+    # CRITICAL AD
+    $win.ftv.tv delete [$win.ftv.tv children {}]
+    #foreach tvitem [$win.ftv.tv children {}] {
+    #    if {$tvitem ni $current_nodes } {
+    #        $win.ftv.tv delete $tvitem
+    #    }
+    #}
+    ##############
+    
+    
+    # create the lines of the treeview
+    foreach current_node $current_nodes {
+        $win.ftv.tv insert {} end -id $current_node -text "$current_node" -image ""
+        
+         # fill each column by value
+        $win.ftv.tv set $current_node lbl $widgetInfo($address.$current_node-variable)
+        set colid 1
+        foreach child $widgetInfo($address-listChildren) {
+            incr colid
+            set child_address "$address.$current_node.$child"
+            $win.ftv.tv set $current_node #$colid $widgetInfo($child_address-variable)
+            
+        }
+    
+        if {$widgetInfo($address.$current_node-status) == "-1" && $widgetInfo($address-status_txt) == ""} {
+            set widgetInfo($address-status_txt) "One or more items are false" 
+        }
+        
+        
+        
+        #change background tags if needed
+        switch $widgetInfo($address.$current_node-status) {
+            "0" {
+                $win.ftv.tv item $current_node -tags "unknown"
+            }
+            "-1" {
+                $win.ftv.tv item $current_node -tags "false"
+            }
+            default {
+                $win.ftv.tv item $current_node -tags "true"
+            }
+        }
+        
+    }
+    
+
+    smartpacker_update_visibility $win $address
+    
+    # catched because if the item is deleted, this selection cannot be done
+    catch {$win.ftv.tv selection set $tvselection} err
+    multiple_sync $win $address "current_selection"
+    
+}
+
+proc multiple_sync {win address row } {
+    global widgetInfo
+
+    #warning "SYNC"
+    if {$row == "current_selection"} {
+        set row [$win.ftv.tv selection]
+    }    
+    if {$row == ""} {
+        switchform_blank $win.children.flipbook 
+    } else {
+        switchform_raise $win.children.flipbook $row 
+    }
+}
+ 
+
+
+
+
+# fills the table of multiple_selection widget
+# in accordance with widgetInfo($address-content) ONLY
+# this should depend of NOTHING ELSE due to the refresh status
+
+
+#
+proc multiple_check {win address } {
+    global widgetInfo tmpTree XMLtree DStree loading 
+    
+    #INITIALIZATIONS
+    set full_address_XML $widgetInfo($address-full_address_XML)
+    set addressesToRefresh ""
+    # get nodes and labels in the widgetInfo(*-content)
+    set current_nodes ""
+    set current_labels ""
+    foreach couple $widgetInfo($address-content) {
+        lappend current_nodes [lindex  $couple 0]
+        lappend current_labels [join [lrange  $couple 1 end]]
+    }
+    # get nodes and labels in the tmpTree
+    set tree_nodes ""
+    set tree_labels ""
+    foreach child [dTree_getChildren_fast $tmpTree $widgetInfo($address-full_address_XML) ] {
+        set name [dTree_getAttribute_fast $tmpTree "$widgetInfo($address-full_address_XML) $child" value ]
+        lappend tree_nodes $child
+        lappend tree_labels $name
+    }
+    
+    
+    # remove all prexistent subnodes in the Tree that are not in the present variable
+    # and the associated switchbooks
+    # update the lists about the tmpTree
+    foreach tree_child $tree_nodes {
+        if {[lsearch $current_nodes $tree_child ]==-1} {
+            dTree_rmBranch tmpTree "[split $address.$tree_child "."]"
+            switchform_del $win.children.flipbook $tree_child
+            
+            set rank [lsearch $tree_nodes $tree_child ]
+            set tree_nodes [lreplace  $tree_nodes $rank $rank  ]
+            set tree_labels [lreplace $tree_labels $rank $rank  ]
+        }
+    }
+    
+    
+    
+    # loop on the names of the variable searching for non existing nodes
+    set rank_in_current 0
+    foreach  current_node $current_nodes {
+        set current_label [lindex $current_labels $rank_in_current]
+    
+        
+        
+        # create the multiple sub_nodes if they do not exists
+        if {[lsearch $tree_nodes $current_node] ==-1} {
+            
+            # tmpTree , node creation
+            multiple_add_subnode $win $address $current_node $current_label
+            
+            # switchForm
+            switchform_add $win.children.flipbook $current_node
+            switchform_raise $win.children.flipbook $current_node
+            
+            ttk::style configure Titled.TLabel -font "helvetica 16 bold" -foreground [ThemeColor 0.50]
+            ttk::label  $win.children.flipbook.$current_node.title -textvariable widgetInfo($address.$current_node-variable) -style "Titled.TLabel"
+            
+            
+            
+            pack $win.children.flipbook.$current_node.title -side top
+            set ListOfPackedWidgets ""
+            set ListOfAllWidgets ""
+            set colid 1
+            foreach child $widgetInfo($address-listChildren) {
+                incr colid
+                set current_nodeType [dTree_getAttribute_fast $XMLtree "$widgetInfo($address-full_address_XML_clean) item $child" "nodeType"]
+                set child_address "$address.$current_node.$child"
+                # theen -recursively- continue the packing
+                gui_addpart -address $child_address -path_father $win.children.flipbook.$current_node -class $current_nodeType
+                
+                set child_win $win.children.flipbook.$current_node.$child
+                
+                # this one is fun...
+                # prefill the check-callback, before asking the building of the widgets
+                append widgetInfo($child_address-check) [subst {
+                    $win.ftv.tv set $current_node #$colid \$widgetInfo($child_address-variable)
+                }]
+                
+                
+                lappend ListOfAllWidgets $child_address
+                if {$widgetInfo(packme-$child_win) != ""} {
+                    lappend ListOfPackedWidgets $child_address
+                }
+                
+                lappend addressesToRefresh $child_address
+            }
+            
+            
+            set maxcols $widgetInfo($address-subcolumns)
+            
+            
+            
+            if {$maxcols > 1 } {
+                
+                # forget
+                pack forget $win.children.flipbook.$current_node.title
+                foreach wa $ListOfPackedWidgets {
+                    pack forget $widgetInfo($wa-win)
+                }
+                
+                # grid title
+                grid $win.children.flipbook.$current_node.title  -column 0 -row 0 -columnspan $maxcols
+                
+                # grid forceps
+                for {set subcol 0 } {$subcol < $maxcols} {incr subcol } {
+                    ttk::frame $win.children.flipbook.$current_node.forceps$subcol -width [expr {int(1.*$widgetInfo(guiSmallWidgetWidth))}] -height 0
+                    grid $win.children.flipbook.$current_node.forceps$subcol  -row 100 -column $subcol
+                }
+   
+                
+                # change callbacks for packing and unpacking
+                set subcol 0
+                set subrow  1
+                set colid 1
+                
+                foreach wa $ListOfAllWidgets {
+                    incr colid
+                    if  {$wa in $ListOfPackedWidgets} {
+                    
+                        # here cant use widgetInfo($address-visibility) because it is not created for children yet
+                        
+                        if {$widgetInfo($wa-visibility) in "hidden not_in_table"} {
+                            set width 0
+                            set minwidth 0
+                        } else {
+                            set width $widgetInfo($address-colwidth)
+                            set minwidth 10
+                        }
+                    
+                        set widget_win $widgetInfo($wa-win)
+                        set widgetInfo(packme-$widget_win) [subst {
+                            set widgetInfo(fixedview) 1
+                            grid $widget_win -row $subrow -column $subcol -sticky news
+                            event generate . <<SetView>>
+                            set widgetInfo(fixedview) 0
+                            $win.ftv.tv column #$colid -width $width -minwidth $minwidth
+                        }]
+                        set widgetInfo(unpackme-$widget_win) [subst {
+                            set widgetInfo(fixedview) 1
+                            grid forget $widget_win 
+                            event generate . <<SetView>>
+                            set widgetInfo(fixedview) 0
+                            $win.ftv.tv column #$colid -width 0 -minwidth 0 
+                        }]
+                        eval $widgetInfo(packme-$widget_win)
+                        incr subcol
+                        if {$subcol == $maxcols} {
+                            set subcol 0
+                            incr subrow 
+                        }
+                    }
+                }
+            }
+           
+            
+        }
+        
+        incr rank_in_current
+    }
+    
+    #set rows  [expr {max([llength $current_nodes],7)}]
+    #$win.ftv.tv configure -height $rows
+    
+    # refresh the familly of the multiple
+    set widgetInfo($address-status) 1
+    foreach addr $addressesToRefresh {
+        RefreshFamily $addr
+    }    
+        
+    set widgetInfo($address-initialized) 1
+    
+    set widgetInfo($address-variable) ""
+}
+
+proc multiple_add_subnode {win address child_node child_label} {
+    global widgetInfo tmpTree
+    #Each subnode acts like a widget and should get everything from a proper node
+    #puts "creating node $child_node $child_label"
+    set args "-path_father $win -address $address.$child_node"
+    set mandatory_arguments { path_father address }
+    initWidget
+    # caution : $address has changed!!!
+    finishWidget
+    set widgetInfo($address-variable) $child_label
+    ##### toChange
+    dTree_setAttribute tmpTree [gui2tree $address] "value" $widgetInfo($address-variable)    
+    #eval $widgetInfo($address-check)
+}
+
+# prepare the filling in a different manner if a require is waiting
+proc multiple_require { win address } {
+    global widgetInfo
+ 
+    set reqVar $widgetInfo($address-requiredValue)
+    # get the present values of the subnodes
+    set list_labels ""
+    foreach couple $widgetInfo($address-content) {
+        set child_node [lindex $couple 0]
+        set child_label [ join [lrange  $couple 1 end] ]
+        lappend list_labels $child_label
+    }
+    
+    
+    # SPECIAL CASE , when widget 
+    # remove nodes if their label cannot match the required list
+    if {$widgetInfo($address-initialized)} {
+    foreach couple $widgetInfo($address-content) {
+            set child_node [lindex $couple 0]
+            set child_label [join [lrange  $couple 1 end]]
+	    if {[lsearch $reqVar $child_label]==-1} {
+                multiple_del_child $win $address $child_node
+		
+            }
+        }
+    }
+    
+    # add new nodes if they do not belong to the variable
+    foreach lbl $reqVar {
+        if {[lsearch $list_labels $lbl]==-1} {
+            multiple_new_child $win $address "end"  $lbl 
+        }   
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_scrollform.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_scrollform.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_scrollform.tcl	(revision 4775)
@@ -0,0 +1,211 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+###############################################
+# Scrolling form, with only vertical scrolling
+# Bindings of scrollbars are redefined to fix a -multiple match binding- problem
+# A binding on mouseWheel is added on the form and its children
+################################################
+
+# creation of the scrollform
+proc scrollform_create {win } {
+	global ScrollInfo widgetInfo
+	
+	
+	set ScrollInfo($win-y0) 0
+	
+	set ScrollInfo(count) 0
+	
+	# main frame
+	ttk::frame $win
+	pack $win -side top -expand 1 -fill both 
+	
+	ttk::scrollbar $win.sbary -orient vertical -command [list $win.vport yview]
+	ttk::scrollbar $win.sbarx -orient horizontal -command [list $win.vport xview]
+	
+	
+	#bind $win.sbary <ButtonPress> [subst { puts "sby $win" }]
+	
+	canvas $win.vport  -xscrollcommand  [list $win.sbarx set] -yscrollcommand  [list $win.sbary set]  -borderwidth 0 -highlightthickness 0 -insertborderwidth 0 -background [ThemeColor 0.9]
+	
+   grid $win.vport -sticky news -column 0 -row 0
+   grid columnconfigure $win 0 -weight 1
+   grid rowconfigure $win 0 -weight 1
+
+   #### TEST ####
+   grid $win.sbary -sticky news -column 1 -row 0
+	grid $win.sbarx -sticky news -column 0 -row 1
+	
+   #### TEST ####
+   
+   #$win.vport configure -background [ThemeColor 1.0]
+   #bind . <<ThemeUpdate>> +[subst {$win.vport configure -background \[ThemeColor 1.0\]}]
+   
+   # form to be scrolled
+     ttk::frame $win.vport.form
+
+   set guiMode $widgetInfo(guimode)
+   set guiWidth $widgetInfo(guiwidth)
+   set guiHeight $widgetInfo(guiheight)
+    
+   
+    $win.vport create window 1 1 -window $win.vport.form  
+    #-width 2000 -height 2000
+		
+    #bind $win.vport.form <Visibility>  [subst { scrollform_upperleft $win}]
+	
+	bind $win.vport.form <Visibility>  [subst { scrollform_resize $win}]
+	
+    
+    bind . <<InitializeGUI>>  +[subst { scrollform_upperleft $win}]
+    
+    return $win
+}
+
+
+# procedure for scrolling using the drag and drop binding
+proc scrollform_scroll {win x y} {
+    global ScrollInfo
+	
+	set gap [expr ($y - $ScrollInfo($win-fy))]
+	
+	if { $gap > 0} {
+		$win.vport yview scroll 1 units
+	}
+	if { $gap < 0} {
+		$win.vport yview scroll -1 units
+	}
+	set ScrollInfo($win-fy) $y
+}
+
+# procedure for scrolling using the MouseWheel binding
+# warning, delta is negative with respect to canvas corrdinate
+proc scrollform_scrollwheel {win delta} {
+	global tabscroll
+	
+	if {$tabscroll} {	
+		set scrollamount [expr int(-$delta)]
+		$win.vport yview scroll $scrollamount units
+		#if {[expr abs($scrollamount) > 3]} {
+		#	set delta [expr int($delta*0.3)]
+		#	 scrollform_scrollwheel $win $delta 
+		#}
+	}
+}
+
+# procedure for scrolling using the MouseWheel binding
+# warning, delta is negative with respect to canvas corrdinate
+proc scrollform_lateralscroll {win delta} {
+	global tabscroll
+	if {$tabscroll} {	
+		set scrollamount [expr int(-$delta)]
+		$win.vport xview scroll $scrollamount units
+		#if {[expr abs($scrollamount) > 3]} {
+		#	set delta [expr int($delta*0.33)]
+		#	 scrollform_lateralscroll $win $delta 
+		#}
+	}
+}
+
+
+# resise the scrollform
+# update the scrollbar visibility
+# propagate mousewheel binding
+
+proc scrollform_resize {win} {
+	global ScrollInfo
+	set  frac_x [lindex [$win.sbarx  get] 0 ]
+	set  frac_y [lindex [$win.sbary  get] 0 ]
+	set bbox [$win.vport bbox all]
+	
+	$win.vport configure -scrollregion $bbox
+	
+	bind . <MouseWheel>  [subst {scrollform_scrollwheel $win %D}]
+	bind . <Shift-MouseWheel>  [subst {scrollform_lateralscroll $win %D}]
+	
+	$win.vport yview moveto $frac_y
+	$win.vport xview moveto $frac_x
+	
+	
+	## get geometry of form
+	#set height [winfo height $win.vport.form]
+	#set width [winfo width $win.vport.form]
+	#
+	## get the bbox of canvas
+	#set bbox [$win.vport bbox all]
+	#
+	## toggle y scrollbar
+	#set win_height [winfo height $win.vport]
+	#if {$height > $win_height && [winfo viewable $win.vport.form ] } {
+	#	grid  $win.sbary -sticky news -column 1 -row 0
+	#	$win.vport configure -scrollregion $bbox 
+	#	bind .  <MouseWheel> [subst {scrollform_scrollwheel $win %D}]
+	#} else {
+	#	$win.vport yview moveto 0.0
+	#	grid forget $win.sbary
+	#	bind . <MouseWheel> ""
+	#}
+	## toggle x scrollbar
+	#set win_width [winfo width $win.vport]
+	#if {$width > $win_width} {
+	#	grid $win.sbarx -sticky news -column 0 -row 1
+	#	$win.vport configure -scrollregion $bbox
+	#	bind .  <Shift-MouseWheel> [subst {scrollform_lateralscroll $win %D}]
+	#} else {
+	#	$win.vport xview moveto 0.0
+	#	grid forget $win.sbarx
+	#	bind . <Shift-MouseWheel> ""
+	#}
+
+	return $win
+}
+
+# Only return where child widget must be packed
+proc scrollform_interior { win } {
+	return $win.vport.form
+
+}
+
+# Only return where child widget must be packed
+proc scrollform_upperleft { win } {
+	global widgetInfo
+	scrollform_resize $win
+	
+	$win.vport xview moveto 0.0
+	$win.vport yview moveto 0.0
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_selection.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_selection.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_selection.tcl	(revision 4775)
@@ -0,0 +1,390 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc selection_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget
+    
+    
+ 
+    
+    ttk::frame $win
+    
+    eval $widgetInfo(packme-$win)
+    
+    
+    ttk::frame $win.forceps -width $widgetInfo(guiSmallWidgetWidth) -height 0     
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    
+    set widgetInfo($address-headings) [dTree_tryGetAttribute $XMLtree $full_address_XML "headings" ""]
+    set widgetInfo($address-controls) [split [dTree_tryGetAttribute $XMLtree $full_address_XML "controls" "toggle"] ";"]
+    set widgetInfo($address-selection) [dTree_tryGetAttribute $XMLtree $full_address_XML "selection" "multiple"] 
+    set widgetInfo($address-filter) ""
+    set widgetInfo($address-col_order) "0"
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-mode) ""   
+    if {[dTree_attrExists $XMLtree $full_address_XML "require"]} {
+        set widgetInfo($address-mode) "require"        
+    }
+    
+    
+    
+    # controls
+    ttk::frame $win.c
+    grid $win.c -sticky e -column 0 -row 0
+    ttk::label $win.c.lb -text "$title:" -justify right
+    ttk::button $win.c.button -text "on" -image icon_checkedunchecked -text "Toggle all" -compound left -command [subst {selection_toggle_all $win $address}]
+    
+    ttk::label $win.c.flb -text "Filter" -justify right
+    ttk::entry $win.c.fle -textvariable widgetInfo($address-filter) -justify right
+    bind $win.c.fle <KeyRelease> [subst {selection_filter $win $address}]
+    
+
+    pack $win.c.lb -side top -fill x    
+    if {"toggle" in $widgetInfo($address-controls)} {
+        pack $win.c.button  -side top -fill x
+    }
+    if {"filter" in $widgetInfo($address-controls)} {
+        pack $win.c.flb -side top -fill x
+        pack $win.c.fle -side top -fill x
+    } 
+    
+    # treeview
+    ttk::treeview  $win.tv -selectmode browse -show {tree} -yscrollcommand [list $win.sby set] -height 10
+    ttk::scrollbar $win.sby -orient vertical -command [list $win.tv yview]
+    grid $win.tv -sticky e -column 1 -row 0
+    grid $win.sby -sticky news -column 2 -row 0
+    
+    
+    
+    
+    
+    bind $win.tv <Button-1> [subst {selection_toggle $win $address \%x \%y} ]
+    bind $win.tv <Enter> [subst { set tabscroll 0 }]
+    bind $win.tv <Leave> [subst { set tabscroll 1 }]
+    
+    
+    #add the check/refresh procedure to the bindings of the variable
+    append widgetInfo($address-check) [ subst {
+        selection_check $win $address
+    }]
+    append widgetInfo($address-refresh) [ subst {
+        selection_refresh $win $address
+    }]
+    finishWidget
+    
+    # to update content if called by a modelXOR
+    selection_refresh $win $address
+    
+    return $win
+}
+
+proc selection_filter { win address } {
+    global widgetInfo
+    
+    # remove the filtered values
+    set new_content ""  
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set key "[lindex $keyvalue 0]"
+        set value  [lindex $keyvalue 1]
+        
+        if {$widgetInfo($address-filter) != "" && ![string match "*$widgetInfo($address-filter)*" $key]} {
+            set value 0
+        }
+        lappend new_content $key
+        lappend new_content $value
+    }
+    
+    set widgetInfo($address-variable) [join $new_content ";" ]
+    selection_refresh $win $address
+    
+    
+}
+
+proc selection_toggle { win address x y} {
+    global widgetInfo
+    
+    set row [$win.tv identify row $x $y]
+    set col [$win.tv identify column $x $y]
+    
+    
+    if {$row != ""} {
+        set new_variable ""
+        foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+            set key [lindex $keyvalue 0]
+            
+            if {$widgetInfo($address-selection)== "single"} {
+                set value 0    
+            } else {
+                set value  [lindex $keyvalue 1]
+            }
+            
+            if {$key == $row } {
+                if {$value == 1} {
+                    set value 0
+                } else {
+                    set value 1   
+                }
+            }
+            lappend new_variable $key
+            lappend new_variable $value
+        }
+        set widgetInfo($address-variable) [join $new_variable ";"]
+        selection_refresh $win $address
+        eval $widgetInfo($address-check)
+        
+        
+    } else {
+        
+        set widgetInfo($address-col_order) [string trim $col \"#\"]
+        selection_refresh $win $address
+       
+    }
+}
+
+
+
+proc selection_toggle_all { win address } {
+    global widgetInfo
+    set all 0
+    set selected 0
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set value  [lindex $keyvalue 1]
+        incr all
+        if {$value == 1} {incr selected}
+    }
+    if {$all == 0} {return}
+    
+    if {[expr {1.*$selected/$all}]>0.5} {
+        set toggle 0
+    } else {
+        set toggle 1
+    }
+    
+    set new_variable ""
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set key [lindex $keyvalue 0]
+        lappend new_variable $key
+        
+        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
+            lappend new_variable $toggle
+        } else {
+            lappend new_variable 0
+        }
+        
+    }
+    
+    set widgetInfo($address-variable) [join $new_variable ";"]
+    
+    selection_refresh $win $address
+    eval $widgetInfo($address-check)
+}
+
+
+
+proc selection_refresh {win address} {
+    global widgetInfo
+    #debug "refresh"
+
+    regsub -all {\s+} $widgetInfo($address-variable) "_" widgetInfo($address-variable)    
+    
+    if {$widgetInfo($address-mode) =="require"} {
+        selection_require $win $address
+    }
+    
+    # Removing old treeview content
+    foreach item [$win.tv children ""] {
+        $win.tv delete $item
+    }
+    
+    
+    
+    # name and width of the first column
+    #$win.tv  configure -columns " "
+    # get columns
+    set nb_column 1
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set nvals [llength [split [lindex $keyvalue 0] "#"]]
+        if {$nb_column < $nvals } { set nb_column $nvals}
+    }
+    set lbl_column ""
+    
+    
+    
+    
+    if {$nb_column > 1} {
+      
+        $win.tv  configure -show {tree headings}
+        $win.forceps configure -width $widgetInfo(guiBigWidgetWidth)
+        set colwidth [expr {int(0.5* $widgetInfo(guiSmallWidgetWidth)) }]
+        
+        for {set i 0} {$i < $nb_column} {incr i} {
+            if {$i>0} {
+                lappend lbl_column col_$i
+            }
+            $win.tv configure -columns $lbl_column
+#            $win.tv column #$i -width $colwidth 
+        }
+        
+    } else {
+        $win.tv  configure -show {tree}
+        $win.forceps configure -width $widgetInfo(guiSmallWidgetWidth)
+        set colwidth [expr {int(0.5* $widgetInfo(guiSmallWidgetWidth)) }]
+        $win.tv column #0 -width $colwidth
+        $win.tv configure -columns ""
+    }
+     
+    set headings [split $widgetInfo($address-headings) ";"]
+    if {$headings != ""} {
+        if {[llength $headings] >= $nb_column  } {
+             for {set i 0} {$i < $nb_column} {incr i} {
+                $win.tv heading #$i -text [lindex $headings $i ]
+            }
+        } else {
+            puts "error, found $nb_column columns with to few headings:  $headings"
+        }
+    }
+    
+    
+     
+    set tvheight [llength [keyvalue_listcsv $widgetInfo($address-variable)]]
+    $win.tv configure -height [expr {min($tvheight,10)}]
+    
+    
+    
+    
+    
+    # Reconstructing and filtering
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set key "[lindex $keyvalue 0]"
+        set value  [lindex $keyvalue 1]
+        
+        set colid 0
+        set head "" 
+        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
+            foreach elmt [split $key "#"] {
+                
+                if {$colid == 0} {
+                    set head $elmt
+                    if $value {
+                        $win.tv insert {} end -id "$key" -text "$head" -image icon_checked
+                    } else {
+                        $win.tv insert {} end -id "$key" -text "$head" -image icon_unchecked
+                    }
+                } else {
+                    $win.tv set "$key" #$colid "$elmt"
+                }
+                incr colid
+            }
+        }
+    }
+    
+    
+    # reorderin
+    set sortlist ""
+    set colid $widgetInfo($address-col_order)
+    
+    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
+        set key [lindex $keyvalue 0]
+        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
+            set keylist [split $key "#"]
+            set elmt [string trim [lindex  $keylist $colid] ]
+            if {$elmt ==""} {set elmt "ZZZZZZ" }
+            lappend sortlist "$key $elmt"
+        }
+    }
+    set sortlist [lsort -dictionary -decreasing -index 1 $sortlist]
+    foreach pair $sortlist {
+        $win.tv move [lindex $pair 0] {} 0
+    }
+}
+
+
+
+proc selection_check {win address} {
+    global widgetInfo
+    
+}
+
+
+# prepare the filling in a different manner if a require is waiting
+proc selection_require { win address } {
+    global widgetInfo
+    
+    #debug "require"
+    
+    set reqVar $widgetInfo($address-requiredValue) 
+    set default [lindex [split $widgetInfo($address-default) ";"]  1]
+    if {$default==""} {set default 0.0 }
+    
+    set new_content ""       
+    # get the present values of the components if they belon to reQvar   
+    foreach actual_component $reqVar {
+        set component_found 0
+        foreach keyvalue [keyvalue_listcsv  $widgetInfo($address-variable)]  {
+            set key [lindex $keyvalue 0]
+            set value [lindex  $keyvalue 1 ]
+            
+            if {$key == $actual_component} {
+                lappend new_content $key
+                lappend new_content $value
+                set component_found 1
+            }
+        }
+        if {$component_found==0 } {
+            lappend new_content $actual_component
+            lappend new_content $default
+        }
+    }
+    
+    
+    set widgetInfo($address-variable) [join $new_content ";" ]
+    
+    # hide id void list
+    if {[llength $new_content] == 0} {
+        pack forget $win
+        return
+    } else {
+        eval $widgetInfo(packme-$win)
+    }
+    
+    #debug "req : $widgetInfo($address-requiredValue) "
+}
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_solverframe.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_solverframe.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_solverframe.tcl	(revision 4775)
@@ -0,0 +1,194 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+# this meta widget is meant to show a full solver
+# all the next publishing will be done in a tabnotebook inside
+
+# initialize the solver frame
+proc solverframe_create { args } {
+    global widgetInfo
+
+    set mandatory_arguments { path_father }
+    
+    read_arguments
+    
+    switch $widgetInfo(guimode) {
+        "treeview" {
+            ttk::treeview  $path_father.tv -selectmode browse -show {tree}
+            set widgetInfo(globaltv.path) $path_father.tv
+            place $path_father.tv -relx 0 -rely 0 -relwidth 0.2 -relheight 1
+            ttk::notebook $path_father.s -style "NoTabs.TNotebook"
+            place $path_father.s -relx 0.2 -rely 0  -relwidth 0.8 -relheight 1
+        }
+        "multicolumn" {
+            ttk::notebook $path_father.s
+            place $path_father.s -relx 0.0 -rely 0 -relwidth 1 -relheight 1
+        }
+    }
+    
+    return $path_father.s
+}
+
+# add a solver as  tab
+proc solverframe_add { args } {
+    global widgetInfo  solverPath 
+
+    set mandatory_arguments { path_father address }
+    
+    initWidget
+    
+    
+    set win $path_father.$name
+    set fileroot "[file join $solverPath "XML"]"
+    foreach item [lrange [split $address "."] 1 end] {
+        set fileroot [file join $fileroot $item]
+    }
+    
+    lappend widgetInfo($path_father-solvernames) $name
+    lappend widgetInfo($path_father-solver-$name-valid) 1
+    
+    # insert object in tree
+    if {$widgetInfo(guimode)=="treeview"} {
+        $widgetInfo(globaltv.path) insert "" end -id $name -text [dTree_getAttribute $XMLtree $full_address_XML "title"] -open 1 -tag $name
+        $widgetInfo(globaltv.path)  tag bind $name <ButtonPress> [subst {$path_father select $path_father.$name}]
+    }
+    
+    if {[dTree_attrExists $XMLtree $full_address_XML "image"]} {
+        set logofile [dTree_getAttribute $XMLtree $full_address_XML "image"]
+        image create photo $logofile -file [file join $fileroot $logofile]
+        $path_father add [ttk::frame $win] -image $logofile -compound left -sticky news
+    } else {
+        $path_father add [ttk::frame $win] -compound left -text [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    }
+    
+    # tabnotebook
+    set win_tn [tabs_create -path_father $win -address "root"]
+    pack $win_tn -side top -fill both -expand true
+    
+    # clean memory if destroyed
+    bind $win <Destroy> "solverframe_destroy $win"
+    
+    set widgetInfo($address-refreshStatus) [subst {
+        solverframe_refreshStatus $win $address $name
+    }]
+
+    finishWidget
+    # return the widget path for next publishing
+    return $win_tn
+}
+
+
+# Utilities
+
+proc solverframe_destroy {win} {
+    global widgetInfo
+    foreach item [array names widgetInfo "$win-*"] {
+        unset widgetInfo($item)
+    }
+}
+
+proc solverframe_refreshStatus {win address name} {
+    global widgetInfo
+     
+    set status $widgetInfo($address-status)
+    # update the graphical state
+    
+    switch $widgetInfo(guimode) {
+        "treeview" {
+            switch $status {
+                "-2" {
+                       #  $win configure -text " "
+                         $widgetInfo(globaltv.path) item $name -image icon_void
+                }
+                "-1" {
+                       # $win configure  -text "Error(s) in the set up"
+                        $widgetInfo(globaltv.path) item $name -image icon_error
+                }
+                "0" {
+                        #$win configure -text "Waiting..."
+                        $widgetInfo(globaltv.path) item $name -image icon_question
+                }
+                "1" {
+                       #$win configure -text "Set up is ready for this solver"
+                        $widgetInfo(globaltv.path) item $name -image icon_ok 
+                }
+            }
+        }
+        "multicolumn" {
+            switch $status {
+                "-2" {
+                         #$win configure -text " "
+                }
+                "-1" {
+                        #$win configure  -text "Error(s) in the set up"
+                }
+                "0" {
+                       # $win configure -text "Waiting..."
+                }
+                "1" {
+                        #$win configure -text "Set up is ready for this solver"
+                }
+            }
+        }
+    }
+}
+
+proc solverframe_docu {address chin help_dir} {
+
+    global widgetInfo XMLtree solverPath    
+    set full_address_XML [split $address "."]
+    
+     if {[dTree_attrExists $XMLtree $full_address_XML "image"]} {
+        set fileroot "[file join $solverPath "XML"]"
+        foreach item [lrange [split $address "."] 1 end] {
+            set fileroot [file join $fileroot $item]
+        }
+        set logofile [dTree_getAttribute $XMLtree $full_address_XML "image"]
+        set path_logofile [file join $fileroot $logofile]
+        set html_image "[join $full_address_XML "_"]_$logofile"
+        file copy -force $path_logofile  [file join $help_dir $html_image]
+        puts $chin "<img src=\"$html_image\">"
+        
+    }
+    
+    
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    puts $chin "<h1> Solver $title </h1>"
+    
+    return
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_status.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_status.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_status.tcl	(revision 4775)
@@ -0,0 +1,95 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# ENTRY CREATION
+
+proc status_create { args } {
+    set mandatory_arguments { path_father address }
+    # Initializes the widget
+    initWidget
+    
+     
+    set widgetInfo($address-status) "0"
+    set widgetInfo($address-status_txt) "" 
+    
+    ttk::frame $win -height 40p -width $widgetInfo(guiSmallWidgetWidth)
+    eval $widgetInfo(packme-$win)
+    ttk::label $win.status -textvariable widgetInfo($address-status_txt) -justify center -compound left
+    $win.status configure -wraplength [expr { 0.9*$widgetInfo(guiSmallWidgetWidth)}]
+    pack $win.status
+    
+    
+    set widgetInfo($address-status) [dTree_tryGetAttribute $XMLtree $full_address_XML "default" "-1"]
+    
+    
+    set widgetInfo($address-msgerr) [dTree_tryGetAttribute $XMLtree $full_address_XML "msgerr" ""]
+    set widgetInfo($address-msgunknown) [dTree_tryGetAttribute $XMLtree $full_address_XML "msgunknown" ""]
+    set widgetInfo($address-msgtrue) [dTree_tryGetAttribute $XMLtree $full_address_XML "msgtrue" ""]
+    
+    
+    
+    append widgetInfo($address-refreshStatus) [ subst { status_refreshStatus $win $address}]
+    
+    eval $widgetInfo($address-refreshStatus)
+    
+    finishWidget
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    return $win
+}
+
+proc status_refreshStatus {win address} {
+    global widgetInfo
+    set widgetInfo($address-status) $widgetInfo($address-variable)
+    
+    switch  $widgetInfo($address-variable) {
+        "-1" {
+            set widgetInfo($address-status_txt) $widgetInfo($address-msgerr)
+            $win.status configure -image icon_flag -foreground red
+        }
+        "0" {
+            set widgetInfo($address-status_txt) $widgetInfo($address-msgunknown)
+             $win.status configure -image "" -foreground orange2
+        }
+        "1" {
+            set widgetInfo($address-status_txt) $widgetInfo($address-msgtrue)
+             $win.status configure -image "" -foreground green4
+        }
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switch.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switch.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switch.tcl	(revision 4775)
@@ -0,0 +1,68 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc switch_create { args } {
+    set mandatory_arguments { path_father address }
+    initWidget
+    
+    ttk::frame $win -height 30p
+    eval $widgetInfo(packme-$win)
+    smartpacker_setup_label $win $address
+    
+    ttk::checkbutton $win.cb -variable widgetInfo($address-variable) -command [ subst {
+        eval \$widgetInfo($address-check)
+    }]
+ 
+    
+    place $win.cb -relx 0.5
+    
+    append widgetInfo($address-refreshStatus) [ subst { switch_refreshStatus $win $address}]
+    finishWidget
+    
+    #always valid
+    set widgetInfo($address-status) 1
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+
+    
+    return $win
+}
+
+proc switch_refreshStatus {win address} {
+    smartpacker_update_visibility $win $address
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switchform.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switchform.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_switchform.tcl	(revision 4775)
@@ -0,0 +1,136 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+###############################################
+# Switch form,based upon the Tabnotebook
+# Beware of multiple matches bindings like in scrollbars
+################################################
+
+# creation of the notebook without tabs 
+proc switchform_create { win } {
+    global widgetInfo
+    ttk::frame $win
+    ttk::frame $win.blank
+    label $win.blank.logo -image bg_200 -text "Nothing selected..." -compound top -font "helvetica 30" -bg [ThemeColor 1.0] -fg [ThemeColor 0.9]
+    
+    pack $win.blank.logo -side left -padx 200 -pady 20
+    
+    pack $win -side top -expand 1 -fill both
+}
+
+# add a tab to the switchform
+proc switchform_add { win name } {
+		ttk::frame $win.$name
+}
+
+# remove a tab to the switchform
+proc switchform_del { win name } {
+		destroy $win.$name
+}
+
+
+# raise a tab in the switchform
+proc switchform_raise { win name } {
+    global widgetInfo
+    catch {
+        if { [winfo ismapped $win.$name] == 0 } {
+            foreach wc [winfo children $win] {
+    	    pack forget $wc 
+    	}
+    	pack $win.$name  -side top -fill x
+	set widgetInfo(fixedview) 1
+    	event generate . <<SetView>>
+	set widgetInfo(fixedview) 0
+        }
+    }
+    
+}
+
+
+# raise a tab in the switchform
+proc switchform_blank { win  } {
+    global widgetInfo
+    catch {
+	foreach wc [winfo children $win] {
+	    pack forget $wc
+	}
+    }
+    pack $win.blank -side top
+    
+    set widgetInfo(fixedview) 1
+    event generate . <<SetView>>
+    set widgetInfo(fixedview) 0
+}
+
+
+# return where child widgets must be packed
+proc switchform_interior { win name } {
+	return $win.$name
+}
+
+
+
+
+
+# former version using tabnotebooks
+
+proc switchform_create2 { win } {
+    ttk::notebook $win -style "NoTabs.TNotebook"
+    ttk::notebook::enableTraversal $win
+    pack $win -side top -expand 1 -fill both
+}
+
+proc switchform_add2 { win name } {
+		$win add [ttk::frame $win.$name] -sticky news
+}
+
+proc switchform_raise2 { win name } {
+    
+    if { [$win select] != "$win.$name" } {
+	$win select $win.$name
+	$win configure -height -1
+	update idletasks
+	set height 0
+        foreach wc [winfo children $win.$name] {
+	    incr height [winfo reqheight $wc]
+	}
+	$win configure -height $height
+    }
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_tabs.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_tabs.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_tabs.tcl	(revision 4775)
@@ -0,0 +1,390 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc tabs_create { args } {
+    global widgetInfo
+    
+    set mandatory_arguments { path_father address}
+    
+    read_arguments
+    
+    
+    switch $widgetInfo(guimode) {
+        "treeview" {
+            ttk::notebook $path_father.nb -style "NoTabs.TNotebook"
+        }
+        "multicolumn" {
+            ttk::notebook $path_father.nb 
+            ttk::notebook::enableTraversal $path_father.nb
+        }
+    }
+    
+    bind $path_father.nb  <<NotebookTabChanged>> [subst {
+        # get the tab under focus , finishing by .vport.form
+        set widgetInfo(tabfocus)  \[$path_father.nb select\]
+        smartpacker_regrid
+        #scrollform_upperleft "\$widgetInfo(tabfocus).sf"
+    }]
+    # make the gui sensitive to SetView to regrid widgets in multicolumns mode
+    bind . <<SetView>> +{tabs_update}
+    
+    
+    bind $path_father.nb <Destroy> "tabs_destroy $path_father.nb"
+    
+    return $path_father.nb
+}
+
+proc tabs_add { args } {
+    global widgetInfo codesPath solverPath
+    set mandatory_arguments { path_father address}
+    
+    initWidget
+    
+    
+    
+    set solver ""
+    set address_solver_XML ""
+    foreach level $full_address_XML {
+        lappend address_solver_XML $level
+        set nodeType [dTree_getAttribute $XMLtree "$address_solver_XML" "nodeType"]
+        if {$nodeType=="solver"} {
+            set solver $level
+        }
+    }
+    
+    set widgetInfo($address-custombutton) [dTree_tryGetAttribute $XMLtree $full_address_XML "custombutton" "Process"]
+    set widgetInfo($address-starttime) "0"
+    set widgetInfo($address-endtime) "0"
+    
+    
+    # insert object in tree
+    if {$widgetInfo(guimode)=="treeview"} {
+        $widgetInfo(globaltv.path) insert $solver end -id $name -text [dTree_getAttribute $XMLtree $full_address_XML "title"] -tag "$solver $solver.$name"
+        $widgetInfo(globaltv.path)  tag bind $solver.$name <ButtonPress> [subst {$path_father select $path_father.$name}]
+    }    
+    
+    set widgetInfo($address-refreshStatus) [subst {
+        tab_refreshStatus $path_father $solver $name $address 
+    }]
+    set title "[dTree_getAttribute $XMLtree $full_address_XML title]"
+    
+    if {[dTree_attrExists $XMLtree $full_address_XML "script"]} {
+        set script [dTree_getAttribute $XMLtree $full_address_XML "script"]
+        set args [split [dTree_tryGetAttribute $XMLtree $full_address_XML "script_args" ""] ";"]
+        set widgetInfo($address-args) $args
+        set widgetInfo($address-scriptAddress) [file join $solverPath scripts $script]
+        if {![file exists $widgetInfo($address-scriptAddress)]} {
+            error "File not found : \n$widgetInfo($address-scriptAddress)"
+        }
+    }
+    
+    lappend widgetInfo($path_father-tabnames) $name
+    lappend widgetInfo($path_father-tab-$name-valid) 1
+    $path_father add [ttk::frame $path_father.$name] -text $title -sticky news
+    
+    
+   
+   
+    
+    
+    set widgetInfo($address-order) [$path_father index  $path_father.$name]
+    
+    if {$widgetInfo(guimode)=="multicolumn"} { 
+        ttk::separator $path_father.$name.sep1 -orient horizontal
+        pack $path_father.$name.sep1 -side top -fill x 
+    }
+    
+    scrollform_create $path_father.$name.sf
+    
+    set winreturn [scrollform_interior $path_father.$name.sf]
+
+    #add help
+    set docu_prefered_side "top"
+    set docu_prefered_place $winreturn
+    help_add_desc_docu_to_widget
+    
+    
+    ttk::separator $path_father.$name.sep2 -orient horizontal
+    pack $path_father.$name.sep2 -side top -fill x
+    
+    ## PROCESS ##
+    set cmd_widget_to_tree [subst {
+        #update_all_widgets $address widget_to_tree
+        set widgetInfo($address-status) 1
+        eval \$widgetInfo($address-refreshStatus)
+    }]
+    
+   
+   
+   
+    
+    ttk::button $path_father.$name.buttW2T -text $widgetInfo($address-custombutton) -command [subst {
+        log "\n@@@@@@@@ Process Tab '$title' @@@@@@@"
+        Validate $win $address
+    }]
+    pack $path_father.$name.buttW2T -side right -anchor e -padx 2 -pady 2
+    
+    ## CANCEL ##
+    set cmd_tree_to_widget [subst {
+        #update_all_widgets $address tree_to_widget
+        RefreshFamily $address
+    }]
+    ttk::button $path_father.$name.buttT2W -text "Cancel" -command $cmd_tree_to_widget
+    #pack $path_father.$name.buttT2W -side right -anchor e -padx 2 -pady 2
+    
+    ### SCRIPT IF NEEDED ####
+    if {[info exists widgetInfo($address-scriptAddress)]} {
+        set widgetInfo($address-progressValue) 0
+        set widgetInfo($address-cancellation) 0
+        ttk::progressbar $path_father.$name.progress  -mode indeterminate 
+        ttk::label $path_father.$name.status -width -20 -textvariable widgetInfo($address-status_txt) -justify left -compound left
+        $path_father.$name.progress stop
+        pack $path_father.$name.progress -side right -anchor e -padx 2 -pady 2    
+        pack $path_father.$name.status -side right -anchor e -padx 2 -pady 2           
+        
+    
+        set widgetInfo($address-onScriptStarts) [subst {
+                CheckValidationStatus $address
+                UpdateValidationStatus $address
+                if {\$widgetInfo($address-status) == -1} {
+                    set widgetInfo($address-cancellation) 1
+                    set widgetInfo($address-status_txt) "Status issue, Cancelled ..."
+                    Stop_think normal
+                } else {
+                    set widgetInfo($address-cancellation) 0
+                    $win.progress start
+                    set widgetInfo(action-callingAddress) $address     
+                    set widgetInfo($address-status_txt) "Running ..."
+                }
+        }]
+        
+        set widgetInfo($address-updateProgress) [subst {
+                $win.progress stop            
+                $win.progress configure -mode determinate -value \$widgetInfo($address-progressValue)
+                            
+        }]
+            
+        set widgetInfo($address-onScriptStops) [subst {
+             $win.progress configure -mode indeterminate            
+            $win.progress stop
+            set widgetInfo($address-status) -1
+            set widgetInfo($address-status_txt) "Execution error : check logs. Took  \[printtime \$widgetInfo($address-starttime) \$widgetInfo($address-endtime) \]  s."                    
+            eval \$widgetInfo($address-refreshStatus)
+        }]
+        
+        set widgetInfo($address-onScriptEnds) [subst {
+             $win.progress configure -mode indeterminate             
+            $win.progress stop
+            set duration  \[format "%0.3f" \[expr {($widgetInfo($address-endtime)-\$widgetInfo($address-starttime))*0.001}  \]\]
+            set widgetInfo($address-status_txt) "Done in   \[printtime \$widgetInfo($address-starttime) \$widgetInfo($address-endtime) \] s."                    
+            if {\$widgetInfo($address-status) != -1} {
+                # Umbrella backward  then upward
+                CheckValidationStatus $address
+                UpdateValidationStatus $address
+            }
+        }]
+    
+    }
+    
+    
+    finishWidget
+    
+    lappend widgetInfo(form_to_update) $path_father.$name
+    
+    return $winreturn
+}
+
+proc tabs_update {}  {
+    global widgetInfo
+    
+    if {"$widgetInfo(ReGrid)" == "no"} {
+         set widgetInfo(ReGrid) [after 10 smartpacker_regrid ]
+    } else {
+        after cancel $widgetInfo(ReGrid)
+        set widgetInfo(ReGrid) [after 10 smartpacker_regrid ]
+    }
+}
+    
+
+# Utilities 
+proc tabs_destroy {win} {
+    global widgetInfo
+    foreach item [array names widgetInfo "$path_father-*"] {
+        unset widgetInfo($item)
+    }
+}
+
+
+proc tab_refreshStatus {path_father solver name tab_address} {
+    global widgetInfo
+    
+    if {$widgetInfo($tab_address-visible)} {
+        $path_father add $path_father.$name
+        if {$widgetInfo(guimode)=="treeview"} {
+            $widgetInfo(globaltv.path) move $name $solver $widgetInfo($tab_address-order)
+        }
+    } else {
+        $path_father hide $path_father.$name
+        if {$widgetInfo(guimode)=="treeview"} {
+            $widgetInfo(globaltv.path) detach $name
+        }
+    }
+    
+    switch $widgetInfo($tab_address-status) {
+        "-2" {
+            switch $widgetInfo(guimode) {
+                "treeview" {
+                    $widgetInfo(globaltv.path) item $name -image icon_void
+                }
+                "multicolumn" {
+                    $path_father tab $path_father.$name -image icon_void -compound left        
+                }
+            }
+        }
+        "-1" {
+            $path_father.$name.buttT2W configure -state normal
+            $path_father.$name.buttW2T configure -state normal
+            switch $widgetInfo(guimode) {
+                "treeview" {
+                    $widgetInfo(globaltv.path) item $name -image icon_error
+                }
+                "multicolumn" {
+                    $path_father tab $path_father.$name -image icon_error -compound left        
+                }
+            }            
+        }
+        "0"  {
+            $path_father.$name.buttT2W configure -state normal
+            $path_father.$name.buttW2T configure -state normal
+            switch $widgetInfo(guimode) {
+                "treeview" {
+                    $widgetInfo(globaltv.path) item $name -image icon_question
+                }
+                "multicolumn" {
+                    $path_father tab $path_father.$name -image icon_question -compound left        
+                }
+            }        
+        }
+        "1"  {
+            #$path_father.$name.buttT2W configure -state disabled
+            #$path_father.$name.buttW2T configure -state disabled
+            switch $widgetInfo(guimode) {
+                "treeview" {
+                    $widgetInfo(globaltv.path) item $name -image icon_ok
+                }
+                "multicolumn" {
+                    $path_father tab $path_father.$name -image icon_ok -compound left        
+                }
+            }        
+        }
+    }
+}
+
+# trigger the update of all widget to tree
+# all values presently stored in widgets are written into the tree
+proc update_widget_to_tree {tab_address} {
+    get_all_widgets $tab_address widget_to_tree
+}
+
+
+# trigger the update of the tree to all widget in this tab
+# all values in the tree DIFFERENT than widget are broadcasted to widget
+proc update_tree_to_widget {tab_address} {
+    get_all_widgets $tab_address tree_to_widget
+}
+
+
+# starting from the tabs address
+# query the list of all widgets address in the case tree (DStree)
+# this list in the fomart .root.AVBP.tab1_mesh.mesh.file will be used
+# in the command "proccess" to update the DS tree according all widgets.
+proc update_all_widgets {tab_address mode} {
+    global  widgetInfo
+    set widgetInfo($tab_address-widgets) ""
+    set address_XML [split $tab_address "." ]
+    
+    recc_get_childs $tab_address "$address_XML" $mode
+}
+
+# search for childs in the case tree.
+# if the child have a value, then
+# if the value differs between tree and widget,
+# the address is stored in tabsInfo
+proc recc_get_childs {tab_address address_XML mode} {
+    global DStree widgetInfo widgetInfo
+    set children [dTree_getChildren $DStree $address_XML]
+    foreach child $children {
+        set child_address_XML "$address_XML $child"
+        set child_address  [join $child_address_XML "."]
+        
+        set isvalue [dTree_attrExists $DStree $child_address_XML "value" ]
+        if {$isvalue} {
+            lappend widgetInfo($tab_address-widgets) $child_address
+        }
+        
+        set tree_value [dTree_getAttribute $DStree "$child_address_XML" "value"]
+        if {$tree_value != $widgetInfo($child_address-variable) && $widgetInfo($child_address-validateMode) == "onProcess"} {
+            switch $mode {
+                "tree_to_widget" {
+                    response_queue Cancel $tab_address treeChange $child_address
+                    event generate . <<treeChange-$child_address>>
+                }
+                "widget_to_tree" {
+                    response_queue Process $tab_address widgetValidate $child_address
+                    event generate . <<widgetValidate-$child_address>>
+                }
+            }
+        }
+        recc_get_childs $tab_address "$child_address_XML" $mode
+    }
+    
+    
+}
+
+
+
+proc tabs_docu {address chin help_dir} {
+
+    global widgetInfo XMLtree     
+    set full_address_XML [split $address "."]
+    
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    puts $chin "<h2> Tab. $title </h2>"
+    
+    return
+}
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_timeline.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_timeline.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_timeline.tcl	(revision 4775)
@@ -0,0 +1,383 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# TIMELINE CREATION
+
+proc timeline_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    set widgetInfo($address-status) 1
+    set widgetInfo($address-message) ""
+    set widgetInfo($address-accepted_keys) {"name" "run" "start" "end" "color" "comment" "sce"}
+    
+    ttk::frame $win 
+    eval $widgetInfo(packme-$win)
+
+    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]   
+    ttk::label $win.lb -text "$title" 
+    ttk::frame $win.t 
+    
+    pack $win.lb -side top -pady 3
+    pack $win.t -side top -pady {0 5}
+    
+    set size_v [expr { (0.6)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size_h [expr { (1)*$widgetInfo(guiSmallWidgetWidth)}] 
+    set size [split [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "size" "1;1" ] ";"]
+    set size_h [expr {int([lindex $size 1]*1.*$size_h)}]
+    set size_v [expr {int([lindex $size 1]*1.*$size_v)}]
+
+    set widgetInfo($address-width) $size_h
+    set widgetInfo($address-height) $size_v
+    set widgetInfo($address-widthcanvas) $size_h
+    set widgetInfo($address-heightcanvas) $size_v
+    
+    
+    # timeline part
+    canvas $win.t.can  -yscrollcommand [list $win.t.sby set] -xscrollcommand [list $win.t.sbx set]   -width $size_h -height $size_v 
+    ttk::scrollbar $win.t.sby -orient vertical -command [list $win.t.can yview]
+    ttk::scrollbar $win.t.sbx -orient horizontal -command [list $win.t.can xview]
+    
+    grid $win.t.can -row 1 -column 0 -sticky news 
+    grid $win.t.sby -row 1 -column 1 -sticky ns
+    grid $win.t.sbx -row 2 -column 0 -sticky ew
+    
+    
+    
+    # controls part
+    ttk::frame $win.c
+    pack $win.c -side top -fill x
+    
+    
+    
+    # message label
+    ttk::label $win.c.message -textvariable widgetInfo($address-message)
+    pack $win.c.message -side left
+    
+    #add the check/refresh procedure to the bindings of the variable
+   
+    append widgetInfo($address-refresh) [ subst { timeline_refresh $win $address}]
+    append widgetInfo($address-check) [subst { timeline_check $win $address}]
+    finishWidget
+    
+    #trick?
+    bind $win.t.can <ButtonPress-1> {+; focus %W}
+    
+    bind $win.t.can <Motion> [subst {timeline_showlocation $win  $address}]
+    
+    #  zoom binding
+    #bind $win.t.can <KeyPress-x> [ subst {timeline_zoom $address $win 0.8 1.0}]
+    #bind $win.t.can <KeyPress-X> [ subst {timeline_zoom $address $win 1.2 1.0}]
+    #bind $win.t.can <KeyPress-y> [ subst {timeline_zoom $address $win 1.0 0.8}]
+    #bind $win.t.can <KeyPress-Y> [ subst {timeline_zoom $address $win 1.0 1.2}]
+    bind $win.t.can <KeyPress-z> [ subst {timeline_zoom $address $win 0.8 0.8}]
+    bind $win.t.can <KeyPress-Z> [ subst {timeline_zoom $address $win 1.2 1.2}]
+    
+    # ctrl move
+    bind $win.t.can <Control-Motion> [ subst {timeline_move $win $address %x %y }]
+    
+    timeline_scrollupdate $win $address 1.0 1.0
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+proc timeline_refresh {win address} {
+    global widgetInfo
+    #$win.t.can create rect 0 0 $widgetInfo($address-widthcanvas) $widgetInfo($address-heightcanvas)  -fill white -tags "xscalable yscalable"
+   
+    $win.t.can delete all
+    
+    set xmin 1000000000
+    set xmax -1000000000
+    set ymin 0
+    set ymax 0
+    set xtitle ""
+    set ytitle ""
+    
+    # first pass, to get bounds
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        set ds_start [timeline_parsecontent $address $dataset "start"]
+        set ds_end [timeline_parsecontent $address $dataset "end"]      
+        if {$ds_end>$xmax} {set xmax $ds_end}
+        if {$ds_start<$xmin} {set xmin $ds_start}
+        incr ymax    
+        
+    }
+
+    
+    if {$ymin == $ymax} {
+        set ymin [expr {$ymin-1.0}]
+        set ymax [expr {$ymax+1.0}]
+    }
+    if {$xmin == $xmax} {
+        set xmin [expr {$xmin-1.0}]
+        set xmax [expr {$xmax+1.0}]
+    }
+    
+    
+    # initialize bounds and scaling
+    set widgetInfo($address-xmin) $xmin
+    set widgetInfo($address-xmax) $xmax
+    set widgetInfo($address-ymin) $ymin
+    set widgetInfo($address-ymax) $ymax 
+    
+    set widgetInfo($address-xscale) [expr {0.8 *$widgetInfo($address-widthcanvas) /($widgetInfo($address-xmax)-$widgetInfo($address-xmin))}]
+    set widgetInfo($address-yscale) [expr {0.8*$widgetInfo($address-heightcanvas)/($widgetInfo($address-ymax)-$widgetInfo($address-ymin))}]
+   
+    
+   
+   
+    # draw frame an midlines
+    set xmin_pix [timeline_pix_x $address $xmin]
+    set xmax_pix [timeline_pix_x $address $xmax]
+    set ymin_pix [timeline_pix_y $address $ymin]
+    set ymax_pix [timeline_pix_y $address $ymax]
+    set xzero_pix [timeline_pix_x $address 0.0]
+             
+    
+    #$win.t.can create text $xmax_pix $ymin_pix -text "$xmax, $ymin" -anchor "se" -tags "xscalable yscalable"
+    #$win.t.can create text $xmin_pix $ymax_pix -text "$xmin, $ymax" -anchor "nw" -tags "xscalable yscalable"
+    foreach frac {0 0.2 0.4 0.6 0.8 1 } {
+        set xfrac  [expr {$frac * $xmin + (1.-$frac)*$xmax}]
+        set xfrac_pix [timeline_pix_x $address $xfrac]
+        $win.t.can create line $xfrac_pix  $ymin_pix $xfrac_pix $ymax_pix -fill grey80 -tags "xscalable yscalable axis"
+        canvas_text_vector $win.t.can $xfrac_pix $ymin_pix [format %.4g $xfrac] se 11 45 black  "xscalable yscalable axis"    
+    }
+    
+    
+    set xtit [expr {0.5 * $xmin + 0.5*$xmax}]
+    set xtit_pix [timeline_pix_x $address $xtit]
+    canvas_text_vector $win.t.can $xtit_pix $ymin_pix "Time \[s\]" se 11 45 black  "xscalable yscalable axis" 
+   
+        
+    
+    
+# second pass pass, to draw
+    set ystart 0
+    foreach dataset [split $widgetInfo($address-variable) "#" ] {
+        
+        set ds_name [timeline_parsecontent $address $dataset "name"]
+        set ds_color [timeline_parsecontent $address $dataset "color"]
+        set ds_run [timeline_parsecontent $address $dataset "run"]
+        set ds_start [timeline_parsecontent $address $dataset "start"]
+        set ds_end [timeline_parsecontent $address $dataset "end"]
+        set ds_comment [timeline_parsecontent $address $dataset "comment"]
+        set ds_sce  [timeline_parsecontent $address $dataset "sce"]
+  
+        
+            
+        set xpix1 [timeline_pix_x $address $ds_start]
+        set xpix2 [timeline_pix_x $address $ds_end]
+        set ypixm [timeline_pix_y $address [expr {$ystart +0.5}]]
+        set ypix1 [timeline_pix_y $address [expr {$ystart +0.2}]]
+        set ypix2 [timeline_pix_y $address [expr {$ystart +0.8}]]
+        if {[expr {$ypix2-$ypix1}] > 20} {
+            set ypix1 [expr {$ypixm - 10}]
+            set ypix2 [expr {$ypixm + 10}]
+        }
+        
+        incr ystart 
+        
+        set shorttitle  "$ds_name#$ds_run"
+        set description  "$ds_name $ds_run $ds_comment"
+        
+       
+        set tags "xscalable yscalable $shorttitle "
+        set h 5
+        
+        $win.t.can create rectangle $xpix1 $ypix1 $xpix2 $ypix2 -fill $ds_color -outline black -width 1 -tags $tags -activewidth 3
+        $win.t.can create oval [expr {$xpix1-$h}] [expr {$ypixm-$h}] [expr {$xpix1+$h}] [expr {$ypixm+$h}] -fill black -outline black -width 1 -tags $tags -activewidth 3
+        canvas_text_vector $win.t.can $xpix2 $ypixm "$shorttitle" e 11 0 black  "xscalable yscalable $shorttitle"        
+        $win.t.can  bind $shorttitle <Enter> [subst {set widgetInfo($address-message) "$description" }]
+        $win.t.can  bind $shorttitle <Leave> [subst {set widgetInfo($address-message) ""}]
+        
+    }
+   
+    $win.t.can lower "axis"
+   
+    $win.t.can configure -scrollregion [ $win.t.can bbox all]
+    
+    smartpacker_update_visibility $win $address
+    
+    #canvas_makegif $win.t.can "$widgetInfo($address-name).gif"
+    
+}
+
+
+proc timeline_parsecontent {address curve_data arg} {
+    global widgetInfo
+    
+    set ds [split $curve_data ";"]
+    set dsi(name) "NAME???"
+    set dsi(run) "RUN_???"
+    set dsi(color) "grey"
+    set dsi(comment) ""
+    set dsi(start) "0.0"
+    set dsi(end) "0.0"
+    set dsi(sce) "0"
+    
+    set dsi(raw) ""
+    
+    foreach item $ds {
+        if {[string match "*=*" $item] == 1} {
+            set key [lindex [split $item "="]  0]
+            set value [lindex [split $item "="] 1]
+            if {$key in $widgetInfo($address-accepted_keys)} {
+
+                if {$key in {"start" "end"} } {
+                    if {![string is double $value]} {
+                        set value "0.0"
+                    }
+                }
+                set dsi($key)  $value
+            } else {
+                debug "Timeline key $key not recognized among $widgetInfo($address-accepted_keys)"
+            }
+        } else {
+            lappend dsi(raw) $item
+        }
+    
+    }
+    
+    
+    if {$dsi(end) < $dsi(start)} {
+        set dsi(end) $dsi(start)
+    }
+    
+    return $dsi($arg)
+}
+
+proc timeline_pix_x { address x } {
+    global widgetInfo
+    set xpix [expr {($x -$widgetInfo($address-xmin)) * $widgetInfo($address-xscale)}]
+    return $xpix
+}
+proc timeline_pix_y { address y} {
+    global widgetInfo
+    set ypix [expr {($y - $widgetInfo($address-ymax) ) * $widgetInfo($address-yscale)}]
+    return $ypix
+    
+}
+proc timeline_pix_realx { address xpix} {
+    global widgetInfo
+    set x [expr {$widgetInfo($address-xmin) + $xpix/$widgetInfo($address-xscale)}]
+    return $x
+}
+proc timeline_pix_realy { address ypix} {
+    global widgetInfo
+    set y [expr {$widgetInfo($address-ymax) - $ypix/$widgetInfo($address-yscale)}]
+    return $y
+}
+
+proc timeline_showlocation {win address} {
+    global widgetInfo
+    $win.t.can delete "pointer"
+    set x [$win.t.can canvasx [expr {[winfo pointerx $win.t.can] - [winfo rootx $win.t.can]}]]
+    set y [$win.t.can canvasy [expr {[winfo pointery $win.t.can] - [winfo rooty $win.t.can]}]]
+   
+    set realx [timeline_pix_realx  $address $x  ]
+    set widgetInfo($address-position)  "[format %+.4f $realx]"
+    canvas_text_highlighted $win.t.can $x $y  $widgetInfo($address-position) "pointer"
+}
+
+
+
+proc timeline_scrollupdate { win address xzoom yzoom} {
+    global widgetInfo
+    set width $widgetInfo($address-width)
+    set height $widgetInfo($address-height)
+    set widthcanvas $widgetInfo($address-widthcanvas)
+    set heightcanvas $widgetInfo($address-heightcanvas)
+    
+    set widthcanvas [expr  $widthcanvas*$xzoom ]
+    set heightcanvas [expr $heightcanvas*$yzoom ]
+    
+    set widgetInfo($address-widthcanvas) $widthcanvas
+    set widgetInfo($address-heightcanvas) $heightcanvas
+    
+    set scroll_factor_x [expr 1.0/$width*(1.0-$width*1.0/$widthcanvas)]
+    if { $width > $widthcanvas} { set scroll_factor_x 0}
+    set widgetInfo($address-scroll_factor_x) $scroll_factor_x
+    set scroll_factor_y [expr 1.0/$height*(1.0-$height*1.0/$heightcanvas)]
+    if { $height > $heightcanvas} { set scroll_factor_y 0}
+    set widgetInfo($address-scroll_factor_y) $scroll_factor_y
+    
+}
+
+# to move the canvases using Control_move binding
+proc timeline_zoom { address win xzoom yzoom} {
+    global widgetInfo
+     set y0 0
+     set x0 0
+     $win.t.can scale xscalable $x0 $y0 $xzoom 1
+     $win.t.can scale yscalable $x0 $y0 1 $yzoom
+     
+     set widgetInfo($address-xscale) [expr {$widgetInfo($address-xscale) * $xzoom} ]
+     set widgetInfo($address-yscale) [expr {$widgetInfo($address-yscale) * $yzoom} ]
+     
+     $win.t.can configure -scrollregion [ $win.t.can bbox all]
+     timeline_scrollupdate $win $address $xzoom $yzoom
+   
+}
+
+
+
+
+
+# to move the canvases using Control_move binding
+proc timeline_move { win address x y} {
+    global widgetInfo
+    set xv [expr $x * $widgetInfo($address-scroll_factor_x)]
+    set yv [expr $y * $widgetInfo($address-scroll_factor_y)]
+    $win.t.can xview moveto $xv
+    $win.t.can yview moveto $yv
+}
+
+
+proc timeline_check {win address} {
+    global widgetInfo
+   
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_viewer.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_viewer.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_viewer.tcl	(revision 4775)
@@ -0,0 +1,340 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# ENTRY CREATION
+
+proc viewer_create { args } {
+    set mandatory_arguments { path_father address }
+    
+    # Initializes the widget
+    initWidget  
+    
+    # case when the folders are known beforehand
+    set folders ""
+    if  {[dTree_attrExists $XMLtree  $full_address_XML_clean "folders"]==1} {
+        set list_folder_names [split [dTree_getAttribute $XMLtree $full_address_XML_clean "folders"] "#"]
+        foreach group $list_folder_names {
+            lappend folders [file join {*}[split $group ";"] ]
+        }
+    }
+    
+    #inits
+    set widgetInfo($address-folders) $folders
+    set widgetInfo($address-zoom) "50%"
+    set widgetInfo($address-selimg) ""
+    set widgetInfo($address-status) 1
+    
+    
+    
+    set lightboxcolorbg [ThemeColor 1.0]
+    set lightboxcolorfg [ThemeColor 0.3]
+    
+    set hsize [getcharsize [expr 0.6*$widgetInfo(guiBigWidgetWidth)]]
+    
+    frame $win -bg white
+    eval $widgetInfo(packme-$win)
+    
+    ###############
+    # Canvas part
+    ###############
+    
+    frame $win.img -bg $lightboxcolorbg
+    canvas $win.img.c -width [expr 0.7*$widgetInfo(guiBigWidgetWidth)] -height [expr 0.4*$widgetInfo(guiBigWidgetWidth)] -background $lightboxcolorbg  -highlightthickness 1 -highlightbackground $lightboxcolorbg
+    pack $win.img.c 
+    bind $win.img.c <ButtonPress> [subst {
+        $win.img.c  scan mark %x %y
+    }]
+    bind $win.img.c <B1-Motion> [subst {
+        $win.img.c  scan dragto %x %y 1
+    }]
+    image create photo $address-img
+    $address-img blank
+    $win.img.c create image [expr 0.35*$widgetInfo(guiBigWidgetWidth)] [expr 0.2*$widgetInfo(guiBigWidgetWidth)] -image $address-img 
+    
+    ###############
+    #list of images part
+    ###############
+    
+    frame $win.l -bg $lightboxcolorbg
+    listbox $win.l.lb -listvariable widgetInfo($address-listimg) -yscrollcommand [list $win.l.sb set] -bd 0 -height 6 -width $hsize -selectmode browse -foreground $lightboxcolorfg -background $lightboxcolorbg -selectbackground  $lightboxcolorfg -selectforeground  $lightboxcolorbg
+
+    bind $win.l.lb <<ListboxSelect>> [subst { viewer_curimage $win $address}]
+    
+    grid $win.l.lb -column 0 -row 0 -columnspan 2 -sticky news -padx {10 0} -pady {10 0}
+    scrollbar $win.l.sb -command [list $win.l.lb yview]
+    grid $win.l.sb -column 2 -row 0 -sticky news  -padx {0 10} -pady {10 0}
+    
+    label $win.l.space -text "Image selected:"  -foreground $lightboxcolorfg -background $lightboxcolorbg
+    grid $win.l.space -column 0 -row 1 -sticky news
+    label $win.l.sel -textvariable widgetInfo($address-selimg) -wraplength [expr 0.6*$widgetInfo(guiBigWidgetWidth)] -foreground $lightboxcolorfg -background $lightboxcolorbg
+    grid $win.l.sel -column 1 -row 1 -sticky news 
+    
+    
+    ###############
+    # text part
+    ###############
+    
+    #text $win.txt -width $hsize -height 6 -wrap word -background khaki1 -highlightcolor black -highlightbackground [ThemeColor 0.9] -selectbackground skyblue1
+    text $win.txt -width $hsize -height 6 -wrap word -foreground $lightboxcolorfg -background $lightboxcolorbg -highlightcolor white -highlightbackground $lightboxcolorbg -selectbackground skyblue1
+    #label $win.txt.corner -image icon_corner -compound left -background khaki1 -borderwidth 0
+    #place $win.txt.corner -relx 1.0 -rely 1.0 -anchor se
+    
+    
+    ###############
+    # buttons part
+    ###############
+    
+    ttk::frame $win.b 
+     
+    ttk::button $win.b.del -text "Delete image" -command [subst {viewer_delimage $win $address }]
+    #pack $win.b.del -side left -fill x -padx 4
+    grid $win.b.del -column 0 -row 0 -sticky news -padx 4 -pady 4
+    
+    ttk::button $win.b.save -text "Save Comment"  -command [subst {viewer_savecomment $win $address }]
+    #pack $win.b.save  -side left -fill x  -padx 4
+    grid $win.b.save -column 1 -row 0 -sticky news -padx 4 -pady 4
+
+    ttk::button $win.b.reset -text "Update image list" -command [subst {viewer_update $win $address }]
+    #pack $win.b.reset  -side left -fill x  -padx 4
+    grid $win.b.reset -column 2 -row 0 -sticky news -padx 4 -pady 4
+  
+  
+    ttk::button $win.b.zoomp -image icon_magnifierplus -command [subst {
+        viewer_zoom $win $address "+"
+    }]
+    ttk::button $win.b.zoomm -image icon_magnifierminus -command [subst {
+        viewer_zoom $win $address "-"
+    }]
+    
+    grid $win.b.zoomp -column 3 -row 0 -sticky news -padx 4  -pady 4
+    grid $win.b.zoomm -column 4 -row 0 -sticky news -padx 4  -pady 4
+    
+    ##########################################
+    # case where folder is not known beforehand
+    if {$widgetInfo($address-folders) ==""} {
+        ttk::button $win.b.browsebut -image icon_folder  -compound right -text "Set folder" -command  [subst {
+            set widgetInfo($address-folders) \[tk_chooseDirectory -title "Choose gif images folder" \]
+            viewer_update $win $address
+        }]
+        grid $win.b.browsebut -column 5 -row 0 -sticky news -padx 4  -pady 4
+    }
+    ##########################################
+    
+    set framewidth 0
+    # stacking
+    pack $win.b -side top -fill x  -pady 0 -ipadx $framewidth
+    pack $win.l -side top -fill x -pady "$framewidth 0" -padx $framewidth 
+    pack $win.img -side top -fill x -pady 0 -padx $framewidth
+    pack $win.txt -side top -fill x -pady "0 $framewidth" -padx $framewidth
+    
+    finishWidget
+    
+    # clean the widget callBack on dstruction
+    bind $win <Destroy> [ subst {widget_destroy $win $address}]
+    
+    return $win
+}
+
+
+# to update the list of images
+proc viewer_update {win address} {
+    global widgetInfo
+
+    set  widgetInfo($address-listimg) ""
+    foreach folder $widgetInfo($address-folders) {
+         set widgetInfo($address-listimg) [concat $widgetInfo($address-listimg) [glob -nocomplain [file join $folder *.gif]]]
+    }
+    if {$widgetInfo($address-listimg) == ""} {
+        log "No images to show..."
+        viewer_cleanimg $win $address
+        return
+    }
+    
+    foreach imgfile $widgetInfo($address-listimg) {
+        set rootname [file rootname $imgfile]
+        set name [file tail $rootname]
+        set txtfile "$rootname.txt"
+        if {![file exists $txtfile]} {
+            set fout [open $txtfile w]
+            puts $fout "$name \n no specific comment"
+            close $fout    
+        }
+        
+    }
+    
+    
+}
+
+# to get the current image
+proc viewer_curimage {win address} {
+    global widgetInfo
+    if {$widgetInfo($address-listimg) == ""} {return}
+    set index [$win.l.lb curselection]
+    set widgetInfo($address-selimg) [lindex $widgetInfo($address-listimg) $index]
+                                     
+    viewer_setimage $win $address
+    
+    return 
+}
+
+
+proc viewer_zoom {win address zoom} {
+    global widgetInfo
+    
+    set list_zoom ""
+    lappend list_zoom "25%"
+    lappend list_zoom "33%"
+    lappend list_zoom "50%"
+    lappend list_zoom "100%"
+    
+    set max [llength $list_zoom]
+    set pos [lsearch $list_zoom  $widgetInfo($address-zoom)]
+    
+    
+    switch $zoom {
+        "+" {
+            incr pos
+            if {$pos == $max } {return}
+        }
+        "-" {
+            incr pos -1
+            if {$pos == -1 } {return}
+        }
+    }
+    set widgetInfo($address-zoom) [lindex $list_zoom $pos]
+    viewer_setimage $win $address
+    
+}
+# to save a comment done on an image
+proc viewer_savecomment {win address} {
+    global widgetInfo
+    if {$widgetInfo($address-selimg) == ""} {
+        log "no image selected"
+        return
+    }
+    set rootname [file rootname $widgetInfo($address-selimg)]
+    set txtfile "$rootname.txt"
+    set fout [open $txtfile w]
+    set txt [string trim [$win.txt get 0.0 end]]
+    puts $fout $txt
+    close $fout
+   
+}
+
+# to kill an image and its comment
+proc viewer_delimage {win address} {
+    global widgetInfo
+     if {$widgetInfo($address-selimg) == ""} {
+        log "No image to delete"
+        return
+    }
+    log "Deleting file $widgetInfo($address-selimg)."
+    
+    # keep the line of the last selection    
+    set index [$win.l.lb curselection]
+
+    #delete files
+    set rootname [file rootname $widgetInfo($address-selimg)]
+    file delete -force $widgetInfo($address-selimg)
+    file delete -force "$rootname.txt"
+    
+    #update list
+    viewer_update $win $address
+
+    # exception when the last element is deleted
+    if {$index == [llength $widgetInfo($address-listimg)]} {
+        incr index -1
+    }
+    # switch to next image if any
+    $win.l.lb selection clear 0 end
+    $win.l.lb selection set $index 
+    viewer_curimage $win $address
+}
+
+#to clean the lightbox from an image
+proc viewer_cleanimg {win address} {
+    global widgetInfo
+    $address-img blank
+    $win.txt delete 0.0 end
+    set widgetInfo($address-selimg) ""
+}
+
+
+# to show the curent image
+proc viewer_setimage {win address} {
+    global widgetInfo
+    if {$widgetInfo($address-selimg) == ""} {
+        log "No image to show"
+        viewer_cleanimg $win $address
+        return
+    }
+    
+    # get caption
+    set rootname [file rootname $widgetInfo($address-selimg)]
+    set txtfile "$rootname.txt"
+    set fin [open $txtfile r]
+    set caption [read $fin]
+    close $fin
+    
+    # show caption in text
+    $win.txt delete 0.0 end
+    $win.txt  insert end "$caption" 
+    
+    # show image
+    $address-img blank
+    image create photo tmp-img -file $widgetInfo($address-selimg)
+    switch $widgetInfo($address-zoom) {
+        "25%" {
+            $address-img copy tmp-img -subsample 4 4        
+        }
+        "33%" {
+            $address-img copy tmp-img -subsample 3 3        
+        }
+        "50%" {
+            $address-img copy tmp-img -subsample 2 2        
+        }
+        "100%" {
+            $address-img copy tmp-img -subsample 1 1        
+        }
+    }
+    
+    # resize canvas after image (not used for the moment)
+    #$win.img.c configure -width [image width $address-img] -height [image height $address-img]
+    #$win.img.c configure -scrollregion [ $win.img.c bbox all]
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_window.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_window.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_window.tcl	(revision 4775)
@@ -0,0 +1,1131 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+###########################
+# this procedure handles the
+# creation of the main window
+# with the menu at the top
+###########################
+
+proc createWin {win} {
+    global DStree XMLtree debug widgetInfo FunctionUsed FunctionTime loadApplication applicationList topPath relaunchCmd configPath  faqdata loadedProject wrapper 
+    wm title . "OpenTEA"
+    wm focusmodel . active    
+    . configure -takefocus 1
+    
+    raise .
+    
+    if {$widgetInfo(classApp) != "nanoapp"} {
+
+        wm protocol . WM_DELETE_WINDOW {quit_gui}    
+        menu .menu
+        menu .menu.file
+    
+        .menu add cascade -menu .menu.file -label "File"
+        .menu.file add command -label "Load as new" -command { loadProject_as_new }
+        .menu.file add command -label "Load as part " -command {Load_XML_File}
+        
+        .menu.file add command -label "Save" -command {Save_XML_File  "save"} -accelerator "ctrl-s"
+        .menu.file add command -label "Save as" -command {Save_XML_File  "save_as"}    
+        .menu.file add separator
+        #.menu.file add command -label "Import CSV" -command {Load_CSV_File}
+        #.menu.file add command -label "Export CSV" -command {Save_CSV_File}
+        .menu.file add separator
+        .menu.file add command -label "Generate help" -command {Window_help_generator}  -accelerator "ctrl-h"
+        .menu.file add command -label "Preferences" -command {Window_preferences}
+        .menu.file add command -label "About  engine" -command {Window_about}
+        .menu.file add separator
+        .menu.file add command -label "Quit" -command {quit_gui} -accelerator "ctrl-q"
+        
+        menu .menu.apps
+        .menu add cascade -menu .menu.apps -label "Applications"
+        
+        set accessibleApplicationList $applicationList
+        lremove accessibleApplicationList config
+        foreach app $applicationList {
+            set cmd "$relaunchCmd -code $app &"
+            set buttonCommand [subst {
+                wm iconify .
+                puts "Executing $cmd"
+                exec $cmd 
+            }]
+            .menu.apps add command -label $app -command $buttonCommand
+        }
+        
+        menu .menu.config
+        .menu add cascade -menu .menu.config -label "Config"
+        set cmd "$relaunchCmd -code config -file $configPath &"
+        .menu.config add command -label "Edit config" -command [subst {
+            puts "Executing $cmd"
+            exec $cmd
+            
+        }]
+        
+        menu .menu.myproject
+            .menu add cascade -menu .menu.myproject -label "FAQ"
+            foreach faqname $faqdata(faqlist) {
+                .menu.myproject add command -label $faqdata($faqname-title) -command [subst {Window_faq $faqname}]
+            }
+        if {$debug} {
+            menu .menu.debug
+            .menu add cascade -menu .menu.debug -label "Debug"
+            .menu.debug add command -label "Show DSTree" -command {Window_DStree .treeviewDS}
+            .menu.debug add command -label "Show tmpTree" -command {Window_tmptree .treeviewtmp}
+            .menu.debug add command -label "Show XMLTree" -command { Window_XMLtree .treeviewXML}
+            .menu.debug add separator
+            .menu.debug add command -label "Console" -command { Window_console }
+            .menu.debug add command -label "Memory" -command { Window_memory }
+            if {$wrapper} {
+                .menu.debug add command -label "Profiling" -command { Window_profiling }
+            } else {
+                .menu.debug add command -label "Profiling" -state disabled
+                
+            }
+            .menu.debug add command -label "Packing" -command { Window_packing }
+            .menu.debug add command -label "functions usage" -command {
+                puts "=============================="
+                puts "       functions usage (function sorted)"
+                puts "=============================="
+                puts ""
+                puts "Function ; number of calls ; time spent (microsec)"
+                set functionList [list]
+                foreach function [lsort [array names FunctionUsed]] {
+                    
+                    set func "$function $FunctionUsed($function) $FunctionTime($function) 0"
+                    if {$FunctionUsed($function) != 0} {
+                        lset func 3 [expr {$FunctionTime($function) / $FunctionUsed($function)}]
+                    }
+                    
+                    lappend functionList $func
+                }
+                
+                foreach function [lsort -index 2 -integer $functionList] {
+                    puts [join $function " ; "]
+                }
+            }
+            .menu.debug add separator
+            .menu.debug add command -label "AutoPython (dev)" -command { genPyFromXMLtree }        
+        }
+        
+        . config -menu .menu
+    }
+}
+
+
+proc quit_gui {} {
+    global loadedProject widgetInfo log_channel
+    
+    
+    set win .quit
+    
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Quitting..."
+        wm attributes $win 
+        ttk::frame $win.f 
+        pack $win.f -expand 1
+        
+        
+        set wif $win.f
+        
+        
+        
+        ttk::label $wif.icon -image icon_gui_small
+        grid $wif.icon  -column 1 -row 0 -pady 5
+        
+        
+        
+        # QUIT WOS 
+        ttk::frame $wif.quitwos
+        grid  $wif.quitwos -column 1 -row 1 -pady 5
+            ttk::button $wif.quitwos.butt -text "Quit without saving" -command [subst {
+                log  "Quitting  - without saving -"
+                close $log_channel
+                exit
+            }]
+            pack $wif.quitwos.butt -side top -pady 5
+            ttk::label $wif.quitwos.label -wraplength  $widgetInfo(guiSmallWidgetWidth) -text "Brutal quit : if you did some actions since the last save, the GUI will forget them, BUT the files generated will not revert back to the last saved state."
+            pack $wif.quitwos.label -side top -pady 5
+            
+       
+        # CANCEL       
+        ttk::frame $wif.cancel
+        grid  $wif.cancel -column 1 -row 2 -pady 5 
+            
+            ttk::button $wif.cancel.butt -text "Cancel" -command [subst {
+                destroy $win
+                raise .
+                focus .
+            }]
+            pack $wif.cancel.butt -side top -pady 5
+            ttk::label $wif.cancel.label -wraplength  $widgetInfo(guiSmallWidgetWidth) -text "Go back to main GUI. Never mind."
+            pack $wif.cancel.label -side top -pady 20
+        
+        
+        # SAVE ONLY_GREEN    
+        ttk::frame $wif.savegreen
+        grid  $wif.savegreen -column 1 -row 3 -pady 5
+        
+            ttk::button $wif.savegreen.butt -text "Save only green tabs" -command [subst {
+                Save_XML_File "save" "greenonly" 
+                log  "Quitting  - green only -"
+                close $log_channel
+                exit
+            }]
+            pack $wif.savegreen.butt -side top -pady 5
+        
+            ttk::label $wif.savegreen.label  -wraplength  $widgetInfo(guiSmallWidgetWidth) -text   "only green tabs : only the validated tabs (green icon) will be saved, to avoid the storage of incoherences or spurious data." 
+            pack $wif.savegreen.label -side top -pady 5
+            
+            ttk::label $wif.savegreen.l1 -image icon_ok
+            pack $wif.savegreen.l1 -side left -pady 5
+        
+        
+            
+        # SAVE ALL
+        ttk::frame $wif.saveall
+        grid $wif.saveall -column 1 -row 4 -pady 5
+            ttk::button $wif.saveall.butt -text "Save all" -command [subst {
+                Save_XML_File "save" "all"
+                log  "Quitting  - all -"
+                close $log_channel
+                exit
+            }]
+            pack $wif.saveall.butt -side top -pady 5
+            ttk::label $wif.saveall.label -wraplength  $widgetInfo(guiSmallWidgetWidth) -text "all (Ctrl-S): anything in the project, including incoherent data and additionnal data, will be saved. When loaded, tabs will either be valid (green) or invalid (red)."
+            pack $wif.saveall.label -side top -pady 5
+            ttk::label $wif.saveall.l1 -image icon_ok
+            pack $wif.saveall.l1 -side left -pady 5
+            ttk::label $wif.saveall.l2 -image icon_question
+            pack $wif.saveall.l2 -side left -pady 5
+            ttk::label $wif.saveall.l3 -image icon_error -compound left -text "+ (...)" 
+            pack $wif.saveall.l3 -side left -pady 5
+         
+         
+         
+        
+            
+        
+        focus $wif.savegreen.butt
+    }
+    
+    
+    return
+
+    
+}
+
+# Calls for saving and loading files
+
+proc Save_XML_File {mode {typesave "all"} } {
+    global DStree loadApplication metaTree loadedProject workingDir widgetInfo
+    
+    
+    set initialDir $workingDir
+    if {$loadedProject != "none"} {
+        set initialDir [file dirname $loadedProject]
+    } else {
+        set mode "new"
+    }
+    
+    
+    switch $mode {
+        
+        
+        "new" {
+            set msgOpen "New : Choose location to save project"
+            
+            set browsemode [getConfig "config gui paths"]
+            switch $browsemode {
+                "constant" {
+                    set constdir [getConfig "config gui paths constant workingDir"]
+                    set where [tk_getSaveFile -parent .  -initialdir $constdir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+                }
+                "auto" {
+                    set initialdircommand " -initialdir $workingDir"
+                    set where [tk_getSaveFile -parent .  -initialdir $workingDir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+                }
+                "last" -
+                default {
+                    set where [tk_getSaveFile -parent .  -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+                }
+            }
+            
+            if {$where == "" } {
+                return
+            }
+            set where "[file rootname $where].xml"
+        }
+        "save_as" {
+            set msgOpen "Save as : Choose location to save project"
+            set where [tk_getSaveFile -parent . -initialdir [file dirname $loadedProject] -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+            if {$where == "" } {
+                return
+            }
+            set where "[file rootname $where].xml"
+            
+            
+            # copy directory
+            set folderName [file rootname $where]
+            set originFolderName [file rootname $loadedProject]
+            catch {
+                file copy $originFolderName $folderName
+                log "Try to copy $originFolderName into $folderName"
+            } err
+            if {$err != ""} {warning "$err"}
+            
+        }
+        "save" {
+             set where "self"
+        }
+        
+    }
+    
+    saveProject $where "xml" $typesave
+    
+}
+
+
+
+# This proc is a brutal kill and load instruction
+# This avoid the reminiscence of old data in the newly loaded project.
+proc loadProject_as_new { } {
+    global relaunchCmd  configPath loadApplication
+    
+    set msgOpen "Choose the project to load as a new window"
+    set browsemode [getConfig "config gui paths"]
+    switch $browsemode {
+        "constant" {
+            set constdir [getConfig "config gui paths constant workingDir"]
+            set fileName [tk_getOpenFile -parent . -initialdir $constdir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+        }
+        "auto" {
+            set initialdircommand " -initialdir $workingDir"
+            set fileName [tk_getOpenFile -parent . -initialdir $workingDir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+        }
+        "last" -
+        default {
+            set fileName [tk_getOpenFile -parent .  -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+     }
+    }
+
+    if {[file exists $fileName]} {
+        
+        set cmd "$relaunchCmd -code $loadApplication -file $fileName &"
+        puts "Executing $cmd"
+        if { [catch [subst { exec $cmd}] fout] } {
+            popup_error "Could not launch application $loadApplication with file $fileName : \n $fout "
+        } else {
+           exit
+        }
+    }
+}
+
+
+
+# This is a redirection to the main load procedure,
+# without killing the present data
+
+proc Load_XML_File {  } {
+    global workingDir
+    set msgOpen "Choose the project to add as a part"
+    
+    set browsemode [getConfig "config gui paths"]
+    switch $browsemode {
+        "constant" {
+            set constdir [getConfig "config gui paths constant workingDir"]
+            set fileName [tk_getOpenFile -parent . -initialdir $constdir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+        }
+        "auto" {
+            set initialdircommand " -initialdir $workingDir"
+            set fileName [tk_getOpenFile -parent . -initialdir $workingDir -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+        }
+        "last" -
+        default {
+            set fileName [tk_getOpenFile -parent .  -title $msgOpen -filetypes [list {{XML file} {.xml}}]]
+     }
+    }
+
+    if {[file exists $fileName]} {
+        loadProject_as_part $fileName                               
+    }
+}
+
+
+
+proc Load_CSV_File { } {
+    global workingDir
+    set msgOpen "Choose the project to load"
+    set fileName [tk_getOpenFile -parent . -title $msgOpen -filetypes [list {{CSV file} {.csv}}]]
+    if {[file exists $fileName]} {
+        loadProject $fileName                               
+    }
+}
+
+proc Save_CSV_File { } {
+    global DStree loadApplication workingDir
+    set msgOpen "Choose location to save project"
+    set fileName [tk_getSaveFile -parent .  -title $msgOpen -filetypes [list {{CSV file} {.CSV}}]]
+    if {$fileName != "" } {
+        set fileNamelpf "[file rootname $fileName].csv"
+        saveProject $fileNamelpf  "csv" "greenonly"     
+    }
+}
+
+
+
+# Preference window
+proc Window_preferences {} {
+ set win .preferences
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Preferences"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Display"
+        pack $win.f -expand 1
+        
+        
+        set theme_list [ttk::style theme names]
+        set theme [lindex $theme_list 0]
+        
+        
+        # theme 
+        ttk::label $win.f.theme_lbl -text "Theme test" 
+        ttk::combobox $win.f.theme_cbbox -values  [ttk::style theme names]
+        $win.f.theme_cbbox set $theme 
+        bind $win.f.theme_cbbox <<ComboboxSelected>> [ subst {
+            set theme \[ $win.f.theme_cbbox get\]
+            ThemeUpdate \$theme
+        }]
+        grid $win.f.theme_lbl -column 0 -row 0 -padx 10 -pady 10
+        grid $win.f.theme_cbbox -column 1 -row 0  -padx 10 -pady 10
+         
+    }
+}
+
+
+# Preference window
+proc Window_help_generator {} {
+    global workingDir loadApplication help_name help_rootdir help_level
+    set win .help_generator
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Help generation"
+        wm attributes $win 
+        
+        ttk::labelframe $win.f -text "Location"
+        pack $win.f -expand 1  -fill x
+        
+        set help_rootdir "."
+        
+        ttk::label $win.f.dir_lbl -text "Directory" 
+        ttk::entry $win.f.dir_ent -textvariable help_rootdir
+        ttk::button $win.f.dir_but -image  icon_folder -command {
+            set help_rootdir [ tk_chooseDirectory -title "Choose directory to store html help document" -initialdir $workingDir]
+        }
+        
+        set help_name $loadApplication
+        
+        ttk::label $win.f.bname_lbl -text "Basename" 
+        ttk::entry $win.f.bname_ent -textvariable help_name
+        
+        grid $win.f.dir_lbl -column 0 -row 0 -pady 5
+        grid $win.f.dir_ent -column 1 -row 0 -pady 5
+        grid $win.f.dir_but -column 2 -row 0 -pady 5
+       
+        grid $win.f.bname_lbl -column 0 -row 1 -pady 5
+        grid $win.f.bname_ent -column 1 -row 1 -pady 5
+        
+        ttk::labelframe $win.g -text "Generation parameters"
+        pack $win.g -expand 1 -fill x 
+        
+        set help_level 1
+        
+        ttk::label $win.g.lvl_lbl -text "Level of detail:" 
+        ttk::radiobutton $win.g.lvl0 -text "0 - Structure only" -value 0 -variable help_level
+        ttk::radiobutton $win.g.lvl1 -text "1 - Descriptions and help" -value 1 -variable help_level
+        ttk::radiobutton $win.g.lvl2 -text "2 - All parameters " -value 2 -variable help_level
+        ttk::radiobutton $win.g.lvl3 -text "3 - XML names, existifs, requires" -value 3 -variable help_level
+    
+        grid $win.g.lvl_lbl -column 0 -row 0 -sticky w
+        grid $win.g.lvl0 -column 1 -row 0 -sticky w -pady {5 0}
+        grid $win.g.lvl1 -column 1 -row 1 -sticky w
+        grid $win.g.lvl2 -column 1 -row 2 -sticky w
+        grid $win.g.lvl3 -column 1 -row 3 -sticky w
+        
+        ttk::button $win.g.gh_butt -text "Generate help" -command {
+            generate_help_html
+        }
+        
+        grid $win.g.gh_butt -column 0 -columnspan 2 -row 4 -pady 10 
+        
+        ttk::frame $win.h
+        pack $win.h -expand 1 -fill x 
+        
+        ttk::label $win.h.desc  -foreground [ThemeColor 0.20] -text "This dialog allows to generate an HTML file by\ncompiling all the help and descriptions present \nin the GUI. Any web browser can read this file."
+        pack $win.h.desc -expand 1 -fill x -padx 10 -pady 20
+        
+    }
+}
+
+
+proc Window_about {} {
+global engine_version
+ set win .about
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "About engine "
+        wm attributes $win
+        
+        ttk::frame $win.frame
+        pack $win.frame
+        
+        set wif $win.frame
+        
+        ttk::label $wif.icon -image icon_gui_small
+        pack $wif.icon -side top
+        ttk::labelframe $wif.v -text "Engine Version"
+        
+        ttk::label $wif.v.lbl -justify center -text "$engine_version "        
+        pack $wif.v.lbl -expand 1        
+        
+        pack $wif.v -expand 1 -side top -padx 10 -pady 10
+        #pack $wif.c -expand 1 -side top -padx 10 -pady 10
+        pack $wif.d -expand 1 -side top -padx 10 -pady 10
+        
+         
+        ttk::label $wif.cerfacs -image icon_cerfacs -compound left -text "OpenTEA engine is an open-source product of Cerfacs \n under Cecill-B license."
+        pack $wif.cerfacs -side top -pady 10
+    }
+}
+
+
+# create a splash screen to show documentation (and maybe other stuff)
+proc CreateSplashScreen {  } {
+    set win .splash
+    if {[winfo exists $win]} {
+     destroy $win
+    }
+    toplevel $win -background [ThemeColor 0.3]
+    wm title $win ""
+    #wm attributes $win -alpha 0.95
+    wm geometry $win 600x500
+    label $win.exit -text  "EXIT" -foreground [ThemeColor 0.9] -background [ThemeColor 0.3]
+    place $win.exit -relx 0.5 -rely 0.90
+    bind $win.exit <ButtonPress> [subst {destroy $win}]
+
+    return $win
+}
+
+
+# Memory browsers
+
+proc Window_DStree { win} {
+    global DStree
+    #set win .treeviewDS
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Check DS tree content"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Tree view"
+        dTreeBrowser_create $win.f.tree
+        dTreeBrowser_fill $win.f.tree $DStree
+        pack $win.f.tree -expand 1 -fill both
+        
+        
+        pack $win.f -side top -expand 1 -fill both
+        pack $win.f.tree
+            
+        ttk::labelframe $win.bottom
+        ttk::separator $win.bottom.s
+        ttk::button $win.bottom.b -text "Refresh" -command [subst {
+            destroy $win.f.tree
+            dTreeBrowser_create $win.f.tree
+            pack $win.f.tree -expand 1 -fill both
+            dTreeBrowser_fill $win.f.tree \$DStree
+        }]
+
+        pack $win.bottom -side top -fill x
+        pack $win.bottom.s -side top -fill x
+        pack $win.bottom.b -side right -padx 5 -pady 5
+    }
+}
+
+proc Window_tmptree { win} {
+    global tmpTree
+    #set win .treeviewDS
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Check tmp tree content"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Tree view"
+        dTreeBrowser_create $win.f.tree
+        dTreeBrowser_fill $win.f.tree $tmpTree 1
+        pack $win.f.tree -expand 1 -fill both
+        
+        
+        pack $win.f -side top -expand 1 -fill both
+        pack $win.f.tree
+            
+        ttk::labelframe $win.bottom
+        ttk::separator $win.bottom.s
+        ttk::button $win.bottom.b -text "Refresh" -command [subst {
+            destroy $win.f.tree
+            dTreeBrowser_create $win.f.tree
+            pack $win.f.tree -expand 1 -fill both
+            dTreeBrowser_fill $win.f.tree \$tmpTree 1
+        }]
+
+        pack $win.bottom -side top -fill x
+        pack $win.bottom.s -side top -fill x
+        pack $win.bottom.b -side right -padx 5 -pady 5
+    }
+}
+
+proc Window_XMLtree {win} {
+    global XMLtree
+    #set win .treeviewXML
+    
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Check XML tree content"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Tree view"
+        dTreeBrowser_create $win.f.tree
+        dTreeBrowser_fill $win.f.tree $XMLtree
+        pack $win.f.tree -expand 1 -fill both
+        pack $win.f -side top -expand 1 -fill both 
+        pack $win.f.tree
+            
+    }
+}
+
+# Console for debug
+# Allow to execute short bit of code within the execution of the GUI
+proc Window_console {} {
+    set win .devConsole
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Execute some TclTk script on-the-fly"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Script to execute \n (use right click to insert widget)"
+        text $win.f.input -relief sunken -background [ThemeColor 1.1]
+        pack $win.f -side top -expand 1 -fill both 
+        pack $win.f.input -expand 1 -fill both
+            
+        ttk::labelframe $win.bottom
+        ttk::separator $win.bottom.s
+        ttk::button $win.bottom.b -text "Execute" -command {
+            eval [.devConsole.f.input get 1.0 end]
+        }
+        pack $win.bottom -side top -fill x
+        pack $win.bottom.s -side top -fill x
+        pack $win.bottom.b -side right -padx 5 -pady 5
+        
+        bind . <ButtonPress-2> { .devConsole.f.input insert end %W }
+    }
+}
+
+
+# Creation de la fenetre de suivi de la memoire.
+# Juge en particulier la taille en nombre de caracteres des donnees sotckees.
+proc Window_memory { } {
+    set win .devMemory
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Show current memory allocation"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Memory allocation"
+        set width 640
+        set height 480
+        
+        
+        pack $win.f -side top -expand 1 -fill both 
+        
+        canvas $win.f.can -width $width -height $height
+        pack $win.f.can -expand 1 -fill both -side top -padx 5 
+        
+        text $win.f.txt -width 50 -height 10
+        pack $win.f.txt -expand 1 -fill both -side top -padx 5
+        
+        Window_memory_trace $win $width $height
+        
+        button $win.f.butt -text "Update" -command [subst {Window_memory_trace $win $width $height}]
+        pack $win.f.butt -expand 1 -side top -fill both -padx 5 -pady 5
+        
+    }
+    
+}
+
+# Plot de l'occupation memoire
+proc Window_memory_trace { win width height} {
+    
+    $win.f.can delete all
+    set mem_info [ Window_memory_get ]
+    set mem_size [lindex $mem_info 0 ]
+    set mem_list [lrange $mem_info 1 end ]
+    
+    
+    # memory repartition
+    set x0 [expr {int(0.1*$width)}]
+    set y0 [expr {int(0.2*$height)}]
+    set h [expr {int(0.2*$height)}]
+    set span [expr {int(0.8*$width)}]
+    
+    
+    canvas_text_vector $win.f.can $x0 [expr {$y0-20}] "Memory distribution" "e" 10 0 black ""
+    
+    
+    canvas_text_vector $win.f.can $x0 $y0 "0%" "se" 10 45 black ""
+    foreach item $mem_list {
+        set name [lindex $item 0]
+        set size [expr {int($span*[lindex $item 1])}]
+        set ratio [format %0.0f [expr {[lindex $item 1]*100. }]]
+        $win.f.can create rectangle $x0 $y0 [expr {$x0 +$size}] [expr {$y0 +$h}] -fill [randcolor] -tags "$name"
+        incr x0 $size
+        $win.f.can bind "$name" <Motion> [subst {
+            $win.f.can delete "hl"
+            canvas_text_highlighted $win.f.can %x %y  "$name ($ratio/100)" "hl"
+        }]
+    }
+    canvas_text_vector $win.f.can $x0 $y0 "100%" "se" 10 45 black ""
+    
+    set x0 [expr {int(0.1*$width)}]
+    set y0 [expr {int(0.6*$height)}]
+    
+    set bins 10
+    set minbins 5
+    
+    set binspan [expr {int($span/$bins)}]
+    set x1 [expr {int($x0 + $span * log10($mem_size)/$bins)}]
+    
+    
+    
+    canvas_text_vector $win.f.can $x0 $y0 "Memory total  [commify $mem_size] symbols"  "e" 10 0 black ""
+    set y0 [expr {int(0.7*$height)}]
+    set h [expr {int(0.05*$height)}]
+    
+    
+    set cl [colorscale_define rainbow]
+    set color [colorscale_get $cl [expr { (log10($mem_size) - $minbins)/($bins - $minbins) }]]
+    for {set bin 0} {$bin <= $bins } {incr bin} {
+        canvas_text_vector $win.f.can [expr {$x0+$bin*$binspan}] $y0 "[format %g [expr {10**$bin}]]"  "se" 10 45 black ""
+    }
+    $win.f.can create rectangle $x0 $y0 $x1 [expr {$y0 +$h}] -fill $color
+    
+    $win.f.txt insert end "\n [commify $mem_size] symbols"
+    
+}
+
+# Recuperation de l'occupation memoire
+proc Window_memory_get { } {
+    uplevel #0 {
+
+        set list_memory ""
+        set total_char 0
+        foreach var [info vars ] {
+            if {[array exists $var]} {
+                set names [array names $var]
+                
+                
+                set ll 0   
+                foreach name $names {
+                    incr ll [string length [subst $[subst $var]($name)] ]
+                }
+                incr total_char $ll
+                
+                set tll 0
+                foreach cat "status check refresh refreshstatus existIf require" {
+                    set tl 0
+                    foreach name $names {
+                        if {[string match "*$cat" $name  ]} {
+                            incr tl [string length [subst $[subst $var]($name)] ]
+                        }
+                        
+                    }
+                    lappend list_memory "$var.$cat $tl" 
+                    incr tll $tl    
+                }
+                
+                lappend list_memory "$var.misc [expr {$ll-$tll}]" 
+                    
+                
+                
+                
+                
+            } else {
+                set ll [string length [subst $$var]]
+                lappend list_memory "$var $ll" 
+                incr total_char $ll
+            }
+            
+        }
+
+        set list_memory [lsort -index 1 -integer $list_memory]
+        set result "$total_char"
+        foreach rec $list_memory {
+            set size [format "%0.4f" [expr {[lindex $rec 1]*1./$total_char}]]
+            
+            if {$size > 0} {
+                lappend result "[lindex $rec 0] [format "%0.4f" [expr {[lindex $rec 1]*1./$total_char}]]"
+            }
+        }    
+    return $result    
+    }
+    
+}
+
+# Creation de la fenetre de profiling des fonction.
+# N'est accessible qu'en mode debug (wrapper.tcl a la place de" unwrap.tcl.
+# la taile memoire utilisee explose, car on enregistre les debuts et fins de chaque fonction.
+proc Window_profiling { } {
+    set win .devProfiling
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Show  profiling "
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Profiling"
+        set width 640
+        set height 480
+        
+        pack $win.f -side top -expand 1 -fill both 
+        canvas $win.f.can -width $width -height $height
+        pack $win.f.can -expand 1 -fill both -side top -padx 5 
+        
+        text $win.f.txt -width 50 -height 10
+        pack $win.f.txt -expand 1 -fill both -side top -padx 5
+        
+        Window_profiling_trace $win $width $height
+        
+        button $win.f.butt -text "Clean" -command [subst {Window_profiling_clean $win}]
+        pack $win.f.butt -expand 1 -side top -fill both -padx 5 -pady 5
+        button $win.f.butt2 -text "Current profile" -command [subst {Window_profiling_trace $win $width $height}]
+        pack $win.f.butt2 -expand 1 -side top -fill both -padx 5 -pady 5
+        
+        
+    }
+    
+}
+
+# plot e l'occupation memoire
+proc Window_profiling_trace { win width height} {
+    global TraceProfile
+    
+    
+    set TraceProfile 0
+    
+    $win.f.can delete all
+    set prof_info [ Window_profiling_get ]
+    set prof_ttime [lindex $prof_info 0 ]
+    set prof_ttocc [lindex $prof_info 1 ]
+    set prof_list [lrange $prof_info 2 end ]
+    
+    
+    
+    
+    ## profiling repartition
+    set x0 [expr {int(0.3*$width)}]
+    set y0 [expr {int(0.2*$height)}]
+    set h 10
+    set span [expr {int(0.7*$width)}]
+    #
+    #
+    #canvas_text_vector $win.f.can $x0 [expr {$y0-20}] "Memory distribution" "e" 10 0 black ""
+    #
+    #
+    #canvas_text_vector $win.f.can $x0 $y0 "0%" "se" 10 45 black ""
+    foreach item $prof_list {
+        set name [lindex $item 0]
+        set sizet [expr {int($span*[lindex $item 1]*1./$prof_ttime)}]
+        set sizeo [expr {int($span*[lindex $item 2]*1./$prof_ttocc)}]
+        
+        
+        $win.f.can create rectangle $x0 $y0 [expr {$x0 +$sizet}] [expr {$y0 +$h}] -fill red -tags "$name"
+        $win.f.can create rectangle $x0 [expr {$y0 +$h}] [expr {$x0 +$sizeo}] [expr {$y0 +2*$h}] -fill orange -tags "$name"
+        
+        canvas_text_vector $win.f.can $x0 $y0 "$name" "nw" 10 0 black ""
+        
+        incr y0 30
+        
+        $win.f.can bind "$name" <Motion> [subst {
+            $win.f.can delete "hl"
+            canvas_text_highlighted $win.f.can %x %y  "$name \ntime=[commify [lindex $item 1]] microsecondes \noccurences=[lindex $item 2] \n [lindex $item 2]/$prof_ttocc " "hl"
+        }]
+    }
+    
+    set TraceProfile 1
+}
+
+# nettoyage de la fenetre de profiling des fonctions
+proc Window_profiling_clean {win } {
+    global FunctionUsed
+    global FunctionTime
+    foreach name [array names FunctionUsed ] {
+        set FunctionUsed($name) 0
+    }
+    set FunctionTime ""
+    $win.f.can delete all
+    return
+}
+
+
+# analyse de la donnee de profiling
+proc Window_profiling_get { } {
+   
+    global FunctionUsed, FunctionTime, TraceProfile
+    set list_profiling ""
+    set total_char 0
+    set tot_occur 0
+    puts "Wrapper says : "
+    
+    #INITS
+    set FuncNames [array names FunctionUsed ]
+    foreach fun $FuncNames {
+	set FuncCost($fun) 0
+    	set FuncOccur($fun) 0
+    }
+
+    # DATA MINING
+    set tim0 [lindex [split [lindex $FunctionTime 0] "#"] 2 ]
+    set fun0 [lindex [split [lindex $FunctionTime 0] "#"] 1 ]
+    
+    set t0 $tim0
+    
+    foreach item [lrange $FunctionTime 1 end] {
+	set state [lindex  [split $item "#"] 0]
+	set fun [lindex  [split $item "#"] 1]
+	set tim [lindex  [split $item "#"] 2]
+	
+	set dtim [expr {$tim-$tim0}]
+	switch $state {
+	    "IN" {
+		#puts "$fun0 $dtim"
+		incr FuncCost($fun0) $dtim
+                incr FuncOccur($fun)
+                incr tot_occur
+                
+	    }
+	    "OUT" {
+		#puts "$fun $dtim"
+		incr FuncCost($fun) $dtim
+	    }
+	}
+	set fun0 $fun
+	set tim0 $tim
+	
+    }
+    
+    
+    # SORTING
+    set list_time ""
+    set list_occur ""
+    set tot_time 0
+    
+    
+    foreach func $FuncNames {
+	set dtim [format "%0.6f" [expr { $FuncCost($func)*0.000001 }]]
+	if { $dtim > 0 } {
+	    lappend list_time "$func $FuncCost($func) $FuncOccur($func)"
+	    incr tot_time  $FuncCost($func)
+	}
+        
+    }
+    
+    
+    
+    set list_time "$tot_time $tot_occur [lsort -index 1 -decreasing -real $list_time]"
+    
+    
+    
+    #puts "Total time  [format "%0.3f" [expr { $tot_time*0.000001 }]] s."
+    #puts "Total time  [format "%0.3f" [expr { ($tim0-$t0)*0.000001 }]] s."
+    return $list_time
+    
+}
+
+
+# Console pemettant d'identifier l'historique du packing 
+
+proc Window_packing {} {
+    set win .devPacking
+    if {[winfo exists $win]} {
+        wm deiconify $win
+        raise $win
+    } else {
+        toplevel $win
+        wm title $win "Show the packing history of a widget"
+        wm attributes $win 
+        ttk::labelframe $win.f -text "Packing \n (use right click to insert widget)"
+        text $win.f.input -relief sunken -background [ThemeColor 1.1]
+        $win.f.input insert end "right click in the main window to get the packing history"
+        $win.f.input configure -state disabled
+        pack $win.f -side top -expand 1 -fill both 
+        pack $win.f.input -expand 1 -fill both
+        
+        bind . <ButtonPress-2> [subst { Window_show_packing $win %W }]
+    }
+}
+
+# action de recherche du packing
+proc Window_show_packing { win widget} {
+    global widgetInfo
+        set win_list [split $widget "."]
+        
+        $win.f.input configure -state normal    
+        $win.f.input delete 1.0 end
+        
+        set depth [llength $win_list]
+        incr depth -1
+        for {set lvl $depth} {$lvl>=1} {incr lvl -1} {
+            set address "[join [lrange $win_list 0 $lvl] "." ]"
+            $win.f.input insert end "\n" 
+            $win.f.input insert end "[winfo class $address] $address \n"            
+            $win.f.input insert end " manager:[winfo manager $address]\n"
+            $win.f.input insert end " children:\n[join [winfo children $address] "\n"] \n\n"
+            
+            $win.f.input insert end "Absolute widthXheight     :[winfo width $address]X[winfo height $address]\n"
+            $win.f.input insert end "Required widthXheight     :[winfo reqwidth $address]X[winfo reqheight $address]\n"
+            $win.f.input insert end "Geometry  widthxheight+x+y:[winfo geometry $address]\n"
+            $win.f.input insert end "Small Widgets  :$widgetInfo(guiSmallWidgetWidth) pixels\n"
+            $win.f.input insert end "Big Widgets  :$widgetInfo(guiBigWidgetWidth) pixels\n"
+            
+        }
+        $win.f.input configure -state disabled
+}
+
+
+#  update of title
+proc updateTitle {} {
+    global loadApplication
+    global loadedProject
+    
+    wm title . "OpenTEA  [string toupper $loadApplication]  -  [file tail [file rootname $loadedProject]]"
+}
+
+
+
+proc Window_faq {faqname} {
+    global faqdata
+    set win [CreateSplashScreen]
+    text $win.text  -foreground [ThemeColor 0.]  -background [ThemeColor 1.1] -highlightthickness 0 -yscrollcommand [list $win.sbary set]
+    ttk::scrollbar $win.sbary -orient vertical -command [list $win.text yview]
+    
+     
+    $win.text insert end "\n$faqdata($faqname-title) \n" "Title"
+    
+    $win.text configure -wrap word
+    $win.text tag configure "Body" -font "helvetica 12 " -lmargin1 40 -lmargin2 30 -rmargin 30 -foreground [ThemeColor 0.50]
+    $win.text tag configure "Title" -font "helvetica 16 bold" -justify center -foreground [ThemeColor 0.80]
+    $win.text tag configure "Section" -font "helvetica 12 bold"  -lmargin1 40 -lmargin2 30 -rmargin 30  -foreground [ThemeColor 0.65]
+    $win.text tag configure "Float" -font "helvetica 12 bold" -justify center -foreground [ThemeColor 0.50]
+    $win.text tag configure "Item" -font "helvetica 12 " -lmargin1 70 -lmargin2 30 -rmargin 30 -foreground [ThemeColor 0.50]
+    
+    
+        
+    #$win.text insert end "\nFreezing application \n" "Section"
+
+    $win.text insert end "\n $faqdata($faqname-body) \n" "Body"
+  
+    
+    
+    place  $win.text -relx 0.1 -rely 0.1 -relwidth 0.8 -relheight 0.8
+    place  $win.sbary -relx 0.9 -rely 0.1  -relheight 0.8 -anchor ne
+    $win.text configure -state disabled
+    
+}
+
+
+# experiment.
+
+proc temp_launch_py {} {
+    global widgetInfo XDRpath 
+    puts "plouf!"
+    
+    set win "plop"
+    set address "bliblablo"
+    
+    set widgetInfo($address-cancellation) 0
+    
+    set widgetInfo($address-onScriptStarts) ""
+    
+    set widgetInfo($address-onScriptStops) ""
+    
+    set widgetInfo($address-updateProgress) ""
+    
+    set widgetInfo($address-onScriptEnds) ""
+    
+    set widgetInfo($address-scriptAddress) [file normalize [file join $XDRpath "hello.py"]]
+    
+    
+    openPipe $win $address 
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTree.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTree.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTree.tcl	(revision 4775)
@@ -0,0 +1,799 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+# This library is intended to provide a new data structure, the tree, to Tcl 8.5 using dictionaries
+
+#####################
+# Adresses procedures
+#####################
+
+proc gui2tree address {
+    return [split $address .]
+}
+
+proc tree2gui address {
+    return [join $address .]
+}
+
+proc addrGetFather address {
+    return [tree2gui [lrange [gui2tree $address] 0 end-1]]
+}
+
+proc addrGetAncestors address {
+    set result ""
+    while {$address != ""} {
+        set address [addrGetFather $address]
+        if {$address != ""} {
+            lappend result $address
+        }
+    }
+    return $result
+}
+
+# This procedure creates a tree by creating the root node 
+proc dTree_init {dtree} {
+    upvar $dtree tree
+    set tree [dict create]
+    dict set tree "root" description "root of the tree"
+    dict set tree "root" nodeType "node"
+    dict set tree "root" children [list]
+}
+
+
+# This procedure adds a node named node as a children of key in the tree dtree
+proc dTree_addNode {dtree key node} {
+     upvar $dtree tree
+    
+     if {[dict exists $tree $key]} {
+              
+        if {[dict exists $tree "$key $node"]} {
+            error "The node you are trying to add already exists ($key $node)"
+        }
+        set value [dict get $tree $key children]
+        lappend value $node
+        dict set tree $key children $value
+        lappend key $node
+        dict set tree $key children ""
+     } else {
+        #If the father doesn't exist, let's create it !
+        dTree_addNode tree [lrange $key 0 end-1] [lindex $key end]
+        dTree_addNode tree $key $node
+        dTree_setAttribute tree "$key" "value" ""
+        #error "You're trying to add a node but the father node ($key) doesn't exist"
+     }
+}
+
+# used to deref multiple nodes 
+proc dTree_cleanKey2 { key } {
+    set key2 ""
+    foreach key_elt $key {
+        if {[string match item_* $key_elt]} {
+            lappend key2 "item"
+        } else {
+            lappend key2 $key_elt
+        }
+    }
+    return $key2
+}
+
+#  fonctionne , mais delicat a cause de l'addresse qui doit etre protÃ©gÃ©e par des {}
+proc dTree_cleanKey { key } {
+    foreach j [lsearch -all  $key "item_*"] {
+        set key [ lset key $j "item"]
+    }
+    return $key
+}
+
+proc dTree_setAttribute {dtree key attribute value} {
+    upvar $dtree tree
+    if {[dict exists $tree $key]} {
+        dict set tree $key $attribute $value 
+    } else {
+        #error "You're trying to set an attribute on a node which doesn't exist"
+        dTree_addNode tree [lrange $key 0 end-1] [lindex $key end]
+        dict set tree $key $attribute $value        
+    }
+}
+
+
+
+proc dTree_getAttribute_fast {tree key attribute} {
+    return [dict get $tree "$key" $attribute]
+}
+
+
+proc dTree_getAttribute {tree key attribute} {
+    
+    if {[dict exists $tree "$key" $attribute]} {
+        return [dict get $tree "$key" $attribute]
+    } else {
+        set key_clean [dTree_cleanKey $key]
+        if {[dict exists $tree $key_clean $attribute]} {
+            return [dict get $tree $key_clean $attribute]
+        } else {
+            error "You're trying to get an attribute which doesn't exist : $key > $attribute"
+        }
+    }
+    
+}
+
+
+proc dTree_tryGetAttribute_fast {tree key attribute default} {
+    
+    if {[dict exists $tree "$key" $attribute]} {
+        return [dict get $tree "$key" $attribute]
+    } else {   
+        return $default
+    }  
+}
+
+
+proc dTree_tryGetAttribute {tree key attribute default} {
+    
+    if {[dict exists $tree "$key" $attribute]} {
+        return [dict get $tree "$key" $attribute]
+    } else {
+        set key_clean [dTree_cleanKey $key]
+        if {[dict exists $tree $key_clean  $attribute]} {
+            return [dict get $tree $key_clean  $attribute]
+        } else {
+            return $default
+        }
+    }  
+}
+
+
+
+proc dTree_getAttributes {tree node} {
+    set result ""
+    dict for {key value} [dict get "$tree" "$node"] {
+        if {$key != "children"} {lappend result [list $key $value]}
+    }
+    return $result
+}
+
+
+proc dTree_getChildren_fast {tree key} {
+    return [dict get $tree "$key" "children"]
+}
+
+proc dTree_getChildren {tree key} {
+    #return [dict get $tree $key "children"]
+    if {[dict exists $tree "$key" "children"]} {
+        return [dict get $tree "$key" "children"]
+    } else {
+        set key_clean [dTree_cleanKey $key]
+        if {[dict exists $tree $key_clean "children"]} {
+            return [dict get $tree $key_clean "children"]
+        } else {
+            error "You're trying to get children from a node which doesn't exist : $key "
+        }
+    }
+}
+
+proc dTree_getUsedChildren {tree key} {
+    # This function acts like dTree_getChildren but it returns relevant children only
+    # For example, in a xor, only the selected children are returned
+    # This procedure should only be used in tmpTree
+    global XMLtree widgetInfo
+    set cleanKey [dTree_cleanKey $key]
+    if {[dTree_attrExists $XMLtree $cleanKey "nodeType"]} {
+        set nodeType [dTree_getAttribute_fast $XMLtree $cleanKey "nodeType"]
+        switch $nodeType {
+            "xor" {
+                return [dTree_getAttribute_fast $tree $key "value"]
+            }
+            default {
+                set finalChildren ""
+                set children [dTree_getChildren $tree $key]
+                foreach child $children {
+                    if {[info exists widgetInfo([tree2gui "$key $child"]-visible)] == 0} {
+                        lappend finalChildren $child                        
+                    } elseif {$widgetInfo([tree2gui "$key $child"]-visible) == 1} {                
+                        lappend finalChildren $child
+                    }
+                }
+                return $finalChildren
+            }
+        }
+    } else {
+        #warning "The node $key doesn't have a corresponding node in the XMLtree"
+        #eturn [dTree_getChildren $tree $key]
+        return ""
+    }
+ 
+}
+
+proc dTree_rmAttribute {dtree key attribute} {
+    upvar $dtree tree
+    if {[dict exists $tree $key $attribute]} {
+        dict unset tree $key $attribute 
+    } else {
+        error 0 "You're trying to remove an attribute which doesn't exist"
+    }
+}
+
+proc dTree_rmNode {dtree key} {
+    upvar $dtree tree
+    if {[dict exists $tree $key]} {
+        dict unset tree $key
+        set father [lrange $key 0 end-1]
+        set child [lrange $key end end]
+        set fatherListChildren [dict get $tree $father children]
+        set idx [lsearch -exact $fatherListChildren $child]
+        set fatherListChildren [lreplace $fatherListChildren $idx $idx]
+        dict set tree $father children $fatherListChildren
+    } else {
+        error "You're trying to remove a node which doesn't exist"
+    }
+    
+}
+
+proc dTree_rmBranch {dtree node} {
+    upvar $dtree tree
+    foreach child [dTree_getChildren $tree "$node"] {
+        dTree_rmBranch tree "$node $child"
+    }
+    dTree_rmNode tree "$node"
+}
+
+# behaves like a cp 
+# node source adress like : aze rty uio node1
+# node destination addres like : qsd fgh jkl
+# output is : qsd fgh jkl node1
+
+# "nodeName" is the future father of the copied node
+# $node_dest $nodeName" is the full address of the copied node
+
+
+proc dTree_copyBranch {dtree_source node_source dtree_dest node_dest} {
+    upvar $dtree_source tree1
+    upvar $dtree_dest tree2
+    set nodeName [lindex $node_source end]
+    
+    if {[dTree_nodeExists $tree1 "$node_source"]==0} {
+        warning "Cannot copy branch $nodeName from $dtree_source "
+        return 
+    }
+    
+    
+    
+    if {[dTree_nodeExists $tree2 "$node_dest $nodeName"]} {
+        dTree_rmBranch tree2 "$node_dest $nodeName"
+    }
+    dTree_addNode tree2 "$node_dest" $nodeName
+    
+    foreach attribute [dTree_getAttributes $tree1 $node_source] {
+        dTree_setAttribute tree2 "$node_dest $nodeName" [lindex $attribute 0] [lindex $attribute 1]
+    }
+    
+    foreach child [dTree_getChildren $tree1 $node_source] {
+        dTree_copyBranch tree1 "$node_source $child" tree2 "$node_dest $nodeName"
+    }
+}
+
+# to give to a node the same children as an other node
+proc dTree_duplicateBranch {dtree_source node_source node_dest} {
+    upvar $dtree_source tree
+    
+    set sce_path  [lrange $node_source 0 end-1 ]
+    set sce_node  [lindex $node_source end ]
+    set tgt_path  [lrange $node_dest 0 end-1 ]
+    set tgt_node  [lindex $node_dest end ]
+    
+   
+    set value [dTree_getAttribute $tree $node_dest "value" ]
+              
+    dTree_rmBranch tree "$tgt_path $tgt_node"
+    dTree_addNode tree "$tgt_path"  $tgt_node
+   
+    
+    foreach attribute [dTree_getAttributes $tree $node_source] {
+        dTree_setAttribute tree $node_dest [lindex $attribute 0] [lindex $attribute 1]
+    }
+    dTree_setAttribute tree $node_dest "value" $value    
+    
+    
+    foreach child [dTree_getChildren $tree $node_source] {
+        dTree_copyBranch tree "$node_source $child" tree "$node_dest"
+    }
+}
+
+
+
+proc dTree_copyRelevantBranch {dtree_source node_source dtree_dest node_dest} {
+    # This function acts like copyBranch except, it chooses only used nodes (dtree_source should be tmpTree ...)
+    upvar $dtree_source tree1
+    upvar $dtree_dest tree2
+    set nodeName [lindex $node_source end]
+    if {[dTree_nodeExists $tree2 "$node_dest $nodeName"]} {
+        dTree_rmBranch tree2 "$node_dest $nodeName"
+    }
+    
+    dTree_addNode tree2 "$node_dest" $nodeName
+    foreach attribute [dTree_getAttributes $tree1 $node_source] {
+        dTree_setAttribute tree2 "$node_dest $nodeName" [lindex $attribute 0] [lindex $attribute 1]
+    }
+    
+    foreach child [dTree_getUsedChildren $tree1 $node_source] {
+        dTree_copyRelevantBranch tree1 "$node_source $child" tree2 "$node_dest $nodeName"
+    }
+}
+
+
+proc dTree_copyRelevantBranch_ForpartialData {dtree_source node_source dtree_dest node_dest} {
+    # This function acts like copyBranch except, it chooses only used nodes (dtree_source should be tmpTree ...)
+    upvar $dtree_source tree1
+    upvar $dtree_dest tree2
+    set nodeName [lindex $node_source end]
+    #set nodeFather1 "[lrange $node_source 0 end-1]"
+    #set nodeFather2 "root [lrange $nodeFather1 2 end]"
+    
+    
+    # $tree1 donnes a charger
+    # $tree2 donnes cibles
+    
+    set node_source2 "$node_source"
+    if {[string match "item_*" $nodeName ]} {
+        set name1 "[dTree_getAttribute_fast $tree1 "$node_source" "value"]"
+        foreach item [dTree_getChildren_fast  $tree2 $node_dest] {
+            set name2 "[dTree_getAttribute_fast $tree2 "$node_dest $item" "value"]"
+            if {$name1 == $name2} {
+                set node_source2  "$node_dest $item"
+            }
+        }
+        
+    }
+    set nodeName2 [lindex $node_source2 end]
+    
+    # Attributes update
+    foreach attribute [dTree_getAttributes $tree1 $node_source] {
+        dTree_setAttribute tree2 "$node_dest $nodeName2" [lindex $attribute 0] [lindex $attribute 1]
+    }
+    
+    # Childs Update
+    foreach child [dTree_getChildren_fast $tree1 $node_source] {
+        dTree_copyRelevantBranch_ForpartialData tree1 "$node_source $child" tree2 "$node_dest $nodeName2"
+    }
+}
+
+
+
+
+
+proc dTree_moveBranch {dtree_source node_source dtree_dest node_dest} {
+    upvar $dtree_source tree1
+    upvar $dtree_dest tree2
+    dTree_copyBranch tree1 "$node_source" tree2 "$node_dest"
+    dTree_rmBranch tree1 "$node_source"
+}
+
+proc dTree_searchAddress {dtree pattern} {
+    set pattern "*[join [split $pattern { }] *]*"
+    set addresses ""
+    set result ""
+    dict for {node subdict} $dtree {
+        dict for {attr value} $subdict {
+            lappend addresses "$node $attr"
+        }
+    }
+    foreach address $addresses {
+        if {[string match -nocase $pattern $address]} {
+            lappend result $address
+        }
+    }
+    
+    return $result
+}
+
+proc dTree_searchNode {dtree pattern} {
+    # Two types of pattern can be read here :
+    #  -> One with no spaces, it's strict, the function will look for *pattern
+    #  -> If spaces in the pattern, the function searches for all addresses which
+    #     contain every element of the pattern in the order of the pattern
+    
+    if {[regexp {\s} $pattern]} {
+        set pattern [split $pattern { }]
+        set pattern "*[join [lrange $pattern 0 end-1] *]* [lindex $pattern end]"
+    } else {
+        set pattern "* [split $pattern {.}]"
+    }
+    set addresses ""
+    set result ""
+    dict for {node subdict} $dtree {
+        lappend addresses "$node"
+    }
+    foreach address $addresses {
+        if {[string match -nocase $pattern $address]} {
+            lappend result $address
+        }
+    }
+    return $result
+}
+
+proc dTree_searchNode_old {dtree pattern} {
+    set pattern "*$pattern"
+    set addresses ""
+    set result ""
+    dict for {node subdict} $dtree {
+        lappend addresses "$node"
+    }
+    foreach address $addresses {
+        if {[string match -nocase $pattern $address]} {
+            lappend result $address
+        }
+    }
+    return $result
+}
+
+proc dTree_nodeExists {tree key} {
+    
+    return [dict exists $tree $key]
+    
+}
+
+
+proc dTree_attrExists_fast {tree key attribute} {
+    if {[dict exists $tree "$key" $attribute]} {
+        return 1
+    } else {
+        return 0
+    }
+}
+
+proc dTree_attrExists {tree key attribute} {
+    if {[dict exists $tree "$key" $attribute]} {
+        return 1
+    } else {
+        if {[dict exists $tree "[dTree_cleanKey $key]" $attribute]} {
+            return 1
+        } else {
+            return 0
+        }
+    }
+}
+
+proc dTree_puts {args} {
+    set tree [lindex $args 0]
+    set node [lindex $args 1]
+    set indent [lindex $args 2]
+    if {$node == ""} {set node root}
+    puts "$indent ### [lindex $node end]"
+    foreach attr [dTree_getAttributes $tree "$node"] {
+        puts "$indent  > [lindex $attr 0]\t: [lindex $attr 1]"
+    }
+    set indent "$indent   "
+    foreach child [dTree_getChildren_fast $tree "$node"] {
+        dTree_puts $tree "$node $child" $indent
+    }
+}
+
+proc dTree_compareBranch {tree1 tree2 node relevantNodes listDifferentNodes} {
+    # This function compare two trees beginning from 'node'
+    # If the trees are identical, it returns 1
+    # If they are not, it returns 0 and the list of the nodes where the differences begin are stored in 'listDifferentNodes'
+    # In listDifferentNodes, the first element stores the nodes with a difference in the node (arguments are different)
+    # The second element stores the nodes existing in tree2 and not in tree1
+    # The third element stores the nodes existing in tree1 and not in tree2
+    # The fourth element stores the parents of the second and third ones (children are different)
+    
+    #Pour tester :
+#    set l "{} {} {}"
+#    puts [dTree_compareBranch $DStree $tmpTree "root" l]
+    
+#    foreach el [lindex $l 0] {puts "!= $el}    
+#    foreach el [lindex $l 1] {puts "++ $el} 
+#    foreach el [lindex $l 2] {puts "-- $el}     
+    
+    #debug "Comparing $node "    
+    upvar $listDifferentNodes listNodes
+    if {$listNodes == ""} {set listNodes "{} {} {} {}"}
+    set status 1
+    
+    # Retrieve children list
+    if {$relevantNodes != 1} {
+        set children1 [lsort [dTree_getChildren $tree1 $node]]
+        set children2 [lsort [dTree_getChildren $tree2 $node]]
+    } else {
+        set children1 [lsort [dTree_getUsedChildren $tree1 $node]]
+        set children2 [lsort [dTree_getUsedChildren $tree2 $node]]        
+    }
+    
+    # Retrieve arguments
+    set attributes1 [lsort -index 0 [dTree_getAttributes $tree1 $node]]
+    set attributes2 [lsort -index 0 [dTree_getAttributes $tree2 $node]]
+    
+    # Compare, if not the same, return false, no need to test the children ...
+    if {$attributes1 != $attributes2 } {
+        #debug "attributes1 : $attributes1"
+        #debug "attributes2 : $attributes2"
+        
+        set tmpList [lindex $listNodes 0]
+        lappend tmpList "$node"
+        lset listNodes 0 $tmpList
+        
+        return 0
+    }    
+    
+    if { $children1 != $children2 } {
+ 
+        set childrenToTest ""
+        
+        set tmpList [lindex $listNodes 3]
+        lappend tmpList "$node"
+        lset listNodes 3 $tmpList        
+        
+        foreach child $children1 {
+            if {$child ni $children2} {
+                set tmpList [lindex $listNodes 2]
+                lappend tmpList "$node $child"
+                lset listNodes 2 $tmpList                
+            } else {
+                lappend childrenToTest $child
+            }
+        }
+        
+        foreach child $children2 {
+            if {$child ni $children1} {
+                set tmpList [lindex $listNodes 1]
+                lappend tmpList "$node $child"
+                lset listNodes 1 $tmpList     
+                
+                # lremove 
+                set idx [lsearch -exact $childrenToTest $child]
+                set childrenToTest [lreplace $childrenToTest $idx $idx]
+            }
+        }        
+        
+        foreach child $childrenToTest {
+            lappend childrenStatus [dTree_compareBranch $tree1 $tree2 "$node $child" $relevantNodes listNodes]
+        }        
+        
+        return 0    
+    }
+    
+    # If no children and status is 1, comparison is OK, return is possible
+    if {[llength $children1] == 0} {
+        return 1
+    } 
+    
+    # From now, nodes are the same and there are children (which are the same)
+    set childrenStatus ""
+    foreach child $children1 {
+        lappend childrenStatus [dTree_compareBranch $tree1 $tree2 "$node $child" $relevantNodes listNodes]
+    }
+    
+    
+    return [expr min([join $childrenStatus ,])]
+}
+
+#proc saveTree_old {file tree} {
+#    set fileId [open $file w]
+#    puts $fileId $tree
+#    close $fileId
+#}
+
+proc saveXMLnode {fileId tree currentSaveNode indentation} {
+    set indentation "$indentation    "
+    
+    # Calculates list of children to know if there are some
+    set childrenList [dTree_getChildren $tree $currentSaveNode]
+    
+    puts -nonewline $fileId "$indentation<[lindex $currentSaveNode end]"
+    
+    #foreach attribute write it
+    foreach attribute [dTree_getAttributes $tree $currentSaveNode] {
+        puts -nonewline $fileId " [lindex $attribute 0]=\"[lindex $attribute 1]\""
+    }
+    
+    # makes a simple element if no children
+    if {[llength $childrenList] == 0} {
+        puts -nonewline $fileId " /"
+    }
+    puts $fileId ">"
+    
+    #write the XMLContent
+    
+    #foreach child, add indentation, write child
+    foreach child $childrenList {
+        set childNode "$currentSaveNode $child"
+        saveXMLnode $fileId $tree $childNode $indentation
+    }
+    
+    #close tag
+    if {[llength $childrenList] > 0} {
+        puts $fileId "$indentation</[lindex $currentSaveNode end]>"
+    }
+    
+}
+
+
+
+#proc loadTree_old {file itree} {
+#    upvar $itree tree
+#    set fileId [open $file r]
+#    set result [read $fileId]
+#    close $fileId
+#    set tree $result
+#    #dict for {node subdict} $tree {
+#    #    dict for {attr value} $subdict {
+#    #        debug "\ngenerate <<treeChange-[join $node {.}].$attr>>"
+#    #        event generate . <<treeChange-[join $node {.}].$attr>>
+#    #    }
+#    #}
+#    event generate . <<InitializeGUI>>
+#}
+#
+#proc initializeNode {itree node} {
+#    upvar $itree tree
+#    global widgetInfo
+#    foreach child [dTree_getChildren $tree [join [split $node "."] " "]] {
+#        set address "[join $node .].$child"
+#        
+#        # Check if the child is a widget or a container
+#        if {[array names widgetInfo -exact "$address-require"] == ""} {
+#            #child is a container
+#            event generate . <<treeChange-$address>>
+#            initializeNode tree $address
+#            
+#        } else {
+#            #child is a widget
+#            if {$widgetInfo($address-require) == ""} {
+#                #child is an independant widget
+#                
+#                event generate . <<treeChange-$address>>
+#                initializeNode tree $address
+#            } else {
+#                initializeNode tree $widgetInfo($address-requirelist)
+#                initializeNode tree $address
+#            }
+#        }
+#        
+#
+#    }
+#}
+#
+#proc loadXMLProject {file} {
+#    global DStree
+#    global metaTree
+#    global loadedProject
+#    global widgetInfo
+#    global workingDir
+#    dTree_init loadTree
+#    dTree_init dummyTree    
+#    
+#    
+#    
+#}
+#
+#proc loadXMLDataset {file} {
+#    
+#}
+
+proc xml2tree {file itree xmlType} {
+    
+    upvar $itree tree
+    parseFile $file tree "" "DStree"    
+}
+
+proc csv2tree {file itree} {
+    upvar $itree tree
+    
+    # open file
+    set data [read [open $file]]
+    set data [split $data \n]
+    
+    # Foreach line
+    foreach line $data {
+        
+        set line [split $line ";"]
+        if {[string trim [lindex $line 0]] == ""} { continue}
+        # Create address
+        set addressNode "root [join [split [lindex $line 0] {.}] { }]"
+        
+        # Read attribute
+        set attr [join [lrange $line 1 end] ";"]
+        
+        # Create node
+        if {[catch {dTree_addNode tree [lrange $addressNode 0 end-1] [lindex $addressNode end]} fid]} {
+            error "Error reading the CSV file : Make sure all the parents of $addressNode have been set"
+        }
+        
+        # Add attribute
+        #if {$attr != ""} {
+            dTree_setAttribute tree $addressNode "value" "$attr"
+        #}
+    }
+}
+
+proc tree2xml {file tree} {
+    set fileId [open $file w]
+    puts $fileId {<?xml version="1.0" encoding="UTF-8"?>}
+    set indentation ""
+    # save the tree under the root node
+    set childrenList [dTree_getChildren $tree "root"]
+    foreach child $childrenList {
+        set childNode "root $child"
+        saveXMLnode $fileId $tree $childNode $indentation
+    }
+    close $fileId
+}
+
+proc tree2csv {args} {
+    if {[llength $args] == 3} {
+        set file [lindex $args 0]
+        set tree [lindex $args 1]
+        set node [lindex $args 2]
+    } elseif {[llength $args] == 2} {
+        set file [lindex $args 0]
+        set tree [lindex $args 1]
+        set node ""       
+    } else {
+        error "Error with arguments ([llength $args]) : $args"
+    }
+    
+    if {$node == ""} {
+        # Begin the process
+        set node root
+        set fileId [open $file w]
+        
+        set childrenList [dTree_getChildren $tree "root"]
+        foreach child $childrenList {
+            set childNode "root $child"
+            tree2csv $fileId $tree $childNode
+        }
+        
+        close $fileId
+    } else {
+        ###### recursive process
+        
+        # Write node
+        puts -nonewline $file "[join [lrange $node 1 end] {.}]"
+        
+        # Write attributes
+        foreach attribute [dTree_getAttributes $tree $node] {
+            puts -nonewline $file ";[lindex $attribute 1]"
+        }
+        puts $file ""
+        
+        # Write every child
+        set childrenList [dTree_getChildren $tree "$node"]
+        foreach child $childrenList {
+            set childNode "$node $child"
+            tree2csv $file $tree $childNode
+        }
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTreeBrowser.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTreeBrowser.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/dTreeBrowser.tcl	(revision 4775)
@@ -0,0 +1,92 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc dTreeBrowser_create {win} {
+    ttk::frame $win
+    ttk::scrollbar $win.ybar -command "$win.treev yview"
+    ttk::scrollbar $win.xbar -orient horizontal -command "$win.treev xview"
+    ttk::treeview $win.treev -yscrollcommand "$win.ybar set" -xscrollcommand "$win.xbar set" -columns "attribute value"
+
+    
+    $win.treev heading #0 -text "Node"
+    $win.treev heading #1 -text "Attribute"
+    $win.treev heading #2 -text "Value"    
+       
+    pack $win.ybar -side right -fill y
+    pack $win.xbar -side bottom -fill x
+    pack $win.treev -side left -fill both -expand 1
+    return $win
+}
+
+proc dTreeBrowser_fill {args} {
+    set win [lindex $args 0]
+    set tree [lindex $args 1]
+    set status 0
+    catch {set status [lindex $args 2]}
+    dTreeBrowser_fillNode $win $tree "root" $status
+}
+
+proc dTreeBrowser_fillNode {win tree node status} {
+    global widgetInfo
+    set attributs [dTree_getAttributes $tree $node]
+    set children [dTree_getChildren $tree $node]
+    set father [lrange $node 0 end-1]
+    set name [lindex $node end]
+    
+    if {$status == 1} {
+        catch {lappend attributs [list "status" $widgetInfo([tree2gui $node]-status)]}
+        catch {lappend attributs [list "visible" $widgetInfo([tree2gui $node]-visible)]}
+        
+    }
+    
+    $win.treev insert $father end -id $node -text $name  -open true -tags "tree_nodes"
+    
+    foreach att $attributs {
+        $win.treev insert $node end -text "" -values $att -tags "tree_attributes"
+    }
+    
+    foreach child $children {
+        set dummy_node $node
+        lappend dummy_node $child
+        dTreeBrowser_fillNode $win $tree $dummy_node $status
+    }
+  
+    $win.treev tag configure "tree_nodes" -background grey80
+    $win.treev tag configure "tree_attributes" -background grey90
+    $win.treev column  #0 -stretch 0
+    $win.treev column  #1 -stretch 0
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_faq.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_faq.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_faq.tcl	(revision 4775)
@@ -0,0 +1,85 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+set faqdata(faqlist) ""
+
+
+set faqname "validation"
+
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "Validation of tabs"
+set faqdata($faqname-body) "The information written in a tab is validated ONLY through the process button, at the lower left. The states are :\n  - A red cross for an invalid information \n  - An orange interrogation mark for an information in unknown state \n  - A green V mark for a validated information \n \n After the tab processing, the validation of a level is the weakest state of all of its childrens. For example, if a tab is red (invalid), there is at least and without a doubt one of its children or grandchildren information which is invalid."
+
+
+set faqname "freezing"
+
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "Freezing application"
+set faqdata($faqname-body) "During a process, the application will refuse any interaction, in order to prevent the competition of multiple processes. However, the user can get back to normal state using the Escape key to interrupt the process if it takes too much time. \n Note that some low level processes such as external tool execution (Paraview, Fortran) will refuse the interruption. These process must be taken care using the task manager of the computer."
+
+
+
+set faqname "logerror"
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "What to do when the log console shows an error in red?"
+set faqdata($faqname-body) "If a process is giving an error : \n 1 - Read carefully the full length of logs. Most of the errors are explicitely named here. Use the magnifier button to increase the size of the log window.  \n 2 - Check that you are using the correct Plug-in for your situation. (see nest FAQ item)  \n 3 - Check that the inputs given to the plugin are correctly set : login, writable directory, etc...  \n 4 - Share this error, either by reporting it to the manager of your installation, or by sumitting a query on the Redmine website, with the data needed to reproduce the problem.  "
+
+set faqname "plugin"
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "Select the correct plug-in : what is the meaning of this ?"
+set faqdata($faqname-body) "Each computing situation is different. Your computing situation  is the combination of two informations : where do you run the GUI ? where do you run the tools associated to your application ? \nTherefore each site have its own set of plugins. At cerfacs, we have for example cerfacs_formation (for GUI and tool execution on the formation room) or cerfacs_neptune_ssh (for massively parallel code execution on the cluster NEPTUNE). \nIt is a good thing to know clearly what is the range of applications given by your plugin. Ask your code manager about this topic for precise informations. "
+
+    
+
+
+
+set faqname "focus"
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "(Mac OSX) Impossible to write in the entries"
+set faqdata($faqname-body) "On Mac OSX remote execution , e.g. execution on a UNIX platform, trough a terminal to a Mac OSX display, some text entries canot be written. This is due to compatibility issues between different layers of window managers. To resolve the problem, set the parameter Focus correction OSX/X11 to 1 in your config.xml "
+
+
+
+set faqname "circumflex"
+lappend faqdata(faqlist) $faqname
+set faqdata($faqname-title) "(Mac OSX) The key ^ or Âš crashes the application"
+set faqdata($faqname-body) "This is a bug due to the way Mac OSX encode these keys, which can provoke unexpected errors on key bindings.\n
+For applications generating LaTeX documents, a special widget gives among other shortcuts, a macro to insert \^{ } directly on a selected letter."
+
+    
+    
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_icons.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_icons.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/declare_icons.tcl	(revision 4775)
@@ -0,0 +1,364 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+# Engine icons
+image create photo icon_cerfacs -file [file join $pathEngine IMAGES logo_cerfacs.gif]
+
+# if these images are not set before hand, switch back to open tea.
+if {"icon_gui_small" ni [image names] } {
+    image create photo icon_gui_small -file [file join $pathEngine IMAGES logo_opentea_small.gif]    
+}
+if {"icon_gui_tiny" ni [image names] } {
+    image create photo icon_gui_tiny -file [file join $pathEngine IMAGES logo_opentea_tiny.gif]    
+}
+
+
+image create photo icon_garfield -file [file join $pathEngine IMAGES garfield.gif]
+
+# corner icons
+image create photo icon_corner -file [file join $pathEngine IMAGES corner.gif]
+
+# softs de visu
+image create photo icon_paraview -file [file join $pathEngine IMAGES logo_paraview.gif]
+image create photo icon_ensight -file [file join $pathEngine IMAGES logo_ensight.gif]
+image create photo icon_grace -file [file join $pathEngine IMAGES logo_grace.gif]
+
+image create photo icon_magnifierplus -file [file join $pathEngine IMAGES magnifierplus.gif]
+image create photo icon_magnifierminus -file [file join $pathEngine IMAGES magnifierminus.gif]
+image create photo icon_addrow -file [file join $pathEngine IMAGES icon_row_add.gif]
+image create photo icon_delrow -file [file join $pathEngine IMAGES icon_row_delete.gif]
+image create photo icon_graph -file [file join $pathEngine IMAGES icon_graph.gif]
+
+image create photo bullet_1 -file [file join $pathEngine IMAGES bullet_1.gif]
+image create photo bullet_2 -file [file join $pathEngine IMAGES bullet_2.gif]
+image create photo bullet_3 -file [file join $pathEngine IMAGES bullet_3.gif]
+
+image create photo icon_plugin_missing -file [file join $pathEngine IMAGES logo_plugin_missing.gif]
+image create photo icon_plugin_ssh -file [file join $pathEngine IMAGES logo_plugin_ssh.gif]
+image create photo icon_plugin_robot -file [file join $pathEngine IMAGES logo_plugin_robot.gif]
+image create photo icon_plugin_local -file [file join $pathEngine IMAGES logo_plugin_local.gif]
+
+image create photo bg_200 -file [file join $pathEngine IMAGES background200.gif]
+
+
+
+###########################################
+# Icons used for the appearance of widget.
+
+
+# ok grey
+image create photo icon_void -data "R0lGODlhFAAUAOcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4ODg8PD
+xAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEhISIiI
+iMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0NDU1N
+TY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdHR0hIS
+ElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpaWltbW
+1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1tbW5ub
+m9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CAgIGBg
+YKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOTk5SUl
+JWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaampqenp
+6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5ubq6u
+ru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zMzM3Nz
+c7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f3+Dg4
+OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy8vPz8
+/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///yH+GkNyZWF0ZWQgd2l0aCBHSU1QI
+G9uIGEgTWFjACH5BAEKAP8ALAAAAAAUABQAAAj+AP8JHDiwWDGCCBM+uwZu3Lhv154lJKgMmzhw3
+zJ+AxfuGrKJy7qF8+ZNo7du38x9W4bwmLaRGUt+41auHr512Y4RnDZS5reT4+z1mwcOHLWBylCSX
+NoN3Lx+9MJxm6lM4DOYJru144fPnExwzgRKK0oWnLdz+fSd4xauLbhoYt0W/Tau3j511Kpl83YRm
+sBpF8e9Y/fN3T541qRRm1ZNGzeJ/66C21pPnb173RRXo7b4WjOBFbGVw3fvnlppjPNutlZVYDRq1
++rp0wfvWurNsOEizasuXz1v01Rzrlat9UBm1a592xac+OJq1phNZGYN22LOebVdYznxnypkerkUc
+ctWDVmp7gQdoWrFypQi9PC7BwQAOw=="
+# error red flag
+image create photo icon_error  -data "R0lGODlhFAAUAOfsALAAALMAALQAALUAALYAALcAALgAALkAALoAALwAAL0AAL4AALsBAb8AAMIAAMA
+BAb8CAr0EBIcUFJYREb8HB3kaGnsaGnkcHMEJCcIJCcsHB8wHB8sICJAZGbkODqIVFcUMDK8SEsI
+NDbYREdAKCroQEMIODrsQEL8PD7kREbYSErwSEsAREb0SEr8SEsESErQWFrIXF7kYGM4TE84WFr0
+bG88XF6cjI84ZGccgIMkgIMoiIq4xMc0pKckrK78xMdcrK9UsLMovL9YsLNMtLb01NdguLuUrK9Y
+wMNovL80zM9UxMdYxMc8zM800NMI3N9kxMc40NM80NNMzM9cyMsw1NeQvL9czM+ouLuQwMMM5Ods
+zM803N843N9Y1Ndo0NNE3N9o1Ndg2Ntc3N9Y4ONo3N+kzM9c4ONg4OOk0NMQ+Ptg5Odw4ONk5OeY
+2Ntg6Otk6OtY7O9c7O+c3N79CQtk7O9c8PNg8PNg9PcZCQtk9Peg5Ob1FRds9Pdg+PsZDQ9k+Ptg
+/P90+Pto/P8hERNdAQNhAQNlAQMhFRddBQdhBQdlBQeg9PdJDQ9ZCQtpBQchGRthCQsJISNlCQsh
+HR9dDQ9hDQ9JFRdpDQ8lISNhERMpISNlERNpERMlJSeNCQsdKSsZLS9lGRtpGRspLS+1CQtlISMd
+NTedFRcdOTt1JScdPT8hQUN9KSshRUclRUeBLS+NPT+hPT+FUVOFXV+JXV+FYWOFZWexZWetbW+x
+paexra+h1deyBgeuCguiGhumIiPKGhuyKivCOjvCSkvKgoOejo+ukpO+lpfKnp/Krq/Orq+SwsPS
+trfKwsPOysuPDw/PBwfjKyvXNzeTS0u3Q0PXR0enV1e3k5OLr6+js7Obw8ODy8vju7vHz8/fz8+r
+4+Or7+97///n4+PL6+uT+/u78/O7///P///T///X///j////////////////////////////////
+//////////////////////////////////////////////////yH+GkNyZWF0ZWQgd2l0aCBHSU1
+QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAUABQAAAj+AP8JHMiH1apUp0KBojOwYcNXtQY9OgRIzxp
+Ymxw2dGULUydMkyjiedMKkcZ/r25xOrRIFKdJiuRcGaMqj8NXtCxFSmMGkChNcbJgoQJmlJqBkmY
+ZasOImbE9gRxZAQZNVhAplYoIJNUnUZhS1MQdm3NEGLdsu4AoaaJFoKc6gQqxwXWtHDJi27T5+hK
+Fi5MnAjPBweOn0JZc1cKBw9YLSpcqQnz8EEgJjZw7dqa4eWbunDVUIERgoBBBhkBIYs6QWfIpmbd
+v3chFK5PgAAIDIwQSYuIFSSxn6NYN09Ut3TRTCQwUUCHwjyAiRoIFL8bBAa9x6pplCGCA+T8el5J
+g0BiibNmMBgoc/JLWaAABFCEG3uhBwoENHA0eQEBgQocAAizAoNEOGyiwQAMLJMAAAQAY8EIMJ3W
+QgwYIJoDAAQQwwMIHJwkkQQ0utLDCCSV4kMIEHWp0QQUWpOhiigEBADs="
+# error red octogon
+image create photo icon_flag -data "R0lGODlhEAAQAMZpAIQAAIkAAIsAAIwAAI4AAI8AAJIAAJUDAZQEA5gEA5gFA5kFA5oFBJ4LB6EOCaYOC
+qYPCqgPCqoUDakXD7MYELQYELQYEbYZEaodE6oiFLogFcAhF8EhF8AiF8EiF8UjGM0pHM0qHM4qH
+M4rHc0sH9IsH9wuHdk0JPMvGts2Jtw2Jdw3JuY3HNw7Jv8yHvc0Iv8zHvs0Idw9Lf80IN09Lf81I
+d0/MOJBJ+o/LOJEJ9VGO+lCL/9DLf9ELuNMO/9FL/9GMPlJMrxbUupQPv9LNvZOOMRbTv9NNf9QO
+dNeVf9UQPdcR+xfT/9bRf9jUfdpVu5sXf9qVtZ1bO5zZe93avh1ZP51ZOl7bf97aPmBcdiLhP+Je
+fqRg9agm/eZjP+Yi/6kl9Oyr9LBwNXQ0NjZ29/f39/m5+jz8/X29v///////////////////////
+////////////////////////////////////////////////////////////////////yH+GkNyZ
+WF0ZWQgd2l0aCBHSU1QIG9uIGEgTWFjACH5BAEKAH8ALAAAAAAQABAAAAeVgH9of4SFhodmQihWY
+F5XRoeFZzo1Tl9cVCYkGhINB4ZJM0pbWVMpIRwVDwkBhVIwRFhVUDIgGxQPCq2EWi5AUU9MNra4C
+wKFXS48TUtDNCIdFRALA4VhMT1IRTsrIx4W0wSFYi8/R0E4Kt7gCwWFYz4sOTctJyUfFxEMBgCEZ
+JEZMExwgGDXnzKREipcyLChw4d/AgEAOw=="
+# ok green
+image create photo icon_ok -data "R0lGODlhFAAUAOfVAE11GU95GlyRG1uTGl2VGl+VHmCeGmGeGmyyKGy1IG21JXG3J3K4IXK4JHG5IXG5InS
+3LnO5Ina5JXS6I3O6J3O6KHS6Kna6L3e7J3i8JXS/IXe+KHnAK3nBK3rBMHnDJ33BOH7BOnfGInn
+GImjPA2rPBn7FL37FMGvQCWzQCX/GNoHGOYLGOXrLIHrLIW/QEW/QE2zSCW7REG/RD2/REGzTB3D
+RE3DRFHHRE3HRFIHJNW/SEYHJN3LRFHLRFXLRFnDSE3rOHnPRFm/TD3LSFXnPH3PSFnPSF3zPInL
+UFH7PI3LUFXrRHnPUFX7RInnTInbWEnfVGXvTJnnVG3vUJInNRXrVInrWIIDUI4jPPoHTK4rOR37
+VKXzYHonSO4zQR4PYJIPYJYPXMIzTRIrWPoXZM4fZN4/WQ4nZO4jaOpHWSo/YRYvaPYvaP4zaQJD
+YSY3bQY7bQo/bRZDbRZDbRpTZT5DbR5HbR5HbSJHbSZDcRpDcR5HcSJLcR5LcSZLcSpvYWpPcSpP
+cS5faVJPcTJPcTZTcTZLdSZTcTpLdSpHeRZXcTpjaWZPdTJLeSZjbVpTdT5XdTZPeSpTeS5bdUJT
+eTZXeS5fdUZfdUpbeTJbeTZTfSpTfS5XfTZfeUpjeVJneVJffUpnfU5veWZrfVpzfWJ7gWp7gW6D
+fYKDfYqHfZajhcavgdazidqrkcLPghbHigbDjfrzjlb3jl7/jmrjnisLonMXoosfopsrorczqrdP
+ovtboxNnsxtrsyOHu0+Lu1eTu2ent4+Xv2+nt5Ort5u/u7e/u7u/u7+7x6vLv8+/x7Pbv+vXy9vr
+w//fy+v3y//7y//31//71///1///////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+//////////////////////////////////////////////yH+GkNyZWF0ZWQgd2l0aCBHSU1QIG9
+uIGEgTWFjACH5BAEKAP8ALAAAAAAUABQAAAj+AP8JHDgQAQKCCBOG2PLolKlBVUAkJAjhiyhJevZ
+odKQpy4KJF9R0kmOHj0k6bAi5AmQBoYIxm+jg4VOST5pVwJLV8pKAIA9Oduxo3GPHjaph1HxBUqR
+jYIU1h+zgwXMHTxtMvaj9GoUm0ZkGAj1kyvOn7B85bnBNW9YqjqBCljgIVBEJkSE/gRbBidXsGSw
+zl0B9mnRCIItQlAI1otQHVTBotHAQ4UKnVCUTAleQupRKl605uaLxelICB40jYsp8ENjBkqdb0oL
+JKmbsDYkeRnzgeDFFg8AHWqywUobsmLNXJWbkNiJkh5MIA0XUkCLMmbNdVFAsF5IjygiCFIpODJn
+FjFidFD6MMM+RBMkEhBuYXGFEZkaPI0J+wGjiJMNEDEFAEYMMN9gAxBJdKCHBRAIV4EALWIARBhY
+uMCAAgwQFQMABBgwAAIYgMhgQADs="
+# question mark orange
+image create photo icon_question -data "R0lGODlhFAAUAOexAHhSHnxVIJViIJthHJ1jHJllIadnGahnGbJxG7p0Hbp1Hrp4I7t4I/NrAPNtA
+PRtAMN6IcN6IsB7Jsl5IMF7JMB7J8p5IPRwAMN8I/RxAMN8JfVxAM96G/RyAMR9KPRzAMV9KPN0A
+PN1APR1AMl+J/Z1APN2AMh/KPR2APV2APR3APV3AMmAKvN4APR4APR5APR5AfV5ANx+GfV5Afl4A
+M+BJ9x/HM2CK/p5APt5ANWDKPV9COSBGfV+Cvt9A/l/CvWADuyCGNWHMO2DGemEHNWIMdWIM/WCE
+vCDGPKDF9WJM+qFHfWDE/aDFP2CDdqJMf2DDfeFFvSGGPSGGfWGGtyMNfuIGfaJH/KKJOGPOeGQO
+faNJvmNJfaOKPeOKfeQLOqTO+qTPPeRLfeSLveTMfeUMuyWP/eVNveWNveWN/eWOPCYP/CYQPeXO
+PeYOveYO/eZPPeZPfiZPPmZO/mZPPeaPveaP/iaPviaP/maPfebQPebQfibQPibQfubPvecQvecQ
+/icQ/qcQPucQfycP/ucQvidRPidRfudQvieR/qeRPqeRfueQ/2eQvmfSP6eRPyfRfegSv2fRP6fR
+PinV/mnVvioWviqXvmrX/mxa/mzbvq4d/q4ePq7fvq/hvrAh/rDjvvLnfvSqvzSqfzXs/zZt/zew
+Pzfw/zgxP3o0v3o0/3p1f3q2P3s2v3u3/7w4/727////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////yH+GkNyZWF0ZWQgd2l0aCBHS
+U1QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAUABQAAAj+AP8JHDgQAQKCCBOyqMLGkSM2VVgkJMhAi
+yI/dObMyTNoUZYFEyuYmSTnTBo1akzeeWRGAsIEYRqhuVQq1atVoyqp0dMIjAKCTyTZ+fIpllGjr
+Ci1sSPpyUAKbATZIcNJFahNpIx2GmNH0BoKAm9AssOnTiI8Yq5o0kqGjx1INwQKKUSWT5w4ZTC5i
+mXKDRxDfxAJEWhkkJ3Dfd5kghUL1RUUR8b8YaREYBFEZAMd8iIqVismD1CgiNGEiw6BNQgB6pOmy
+44te7Z0UBHDhYoRPzgIhIAlCpUeKjJE8mQJhQoXMWCUSBJhoIwcIVTMaHAqFqwOI2K8UOHDBkENQ
+2hNrIDxIBTfDyherKARBAPCE0hwmGixA0iPFy1E4EBCYiIIIk7gsIEDF6SAAxRLeDCRQAVYwMMUV
+lghBQ8TCLAgQQEQcIABAwBw4YcLBgQAOw=="
+
+# question blue
+image create photo icon_info -data "R0lGODlhEgASAOZ/AOLl6hZCu8zb6hhWyOXy/Mzk93ip5JjN9ESV5TBIuPL2+zZkxzd71YOVyUes88nJy
+erq66nT93m78y6M5TSb79Lk8ll5yDSB3rvI4arK6azE4+nr7meO1ws3t6XI6kej7iBq09rp+Rtfz
+Tp0z4i97WeW3Tmc7evs8RNKwsPP7sHM4Sh+342v38XK3F2Y3CNVw9He6zGV687T3iR02WtwmSyF4
+tnl8Sd63WSz8tbd55WVnAclrNjY2snJ1onL9XDB9YzC7U6x9Dyg8Bsjh////+bm59TU1LS0tAkTl
+YaGleDg4FOP1x8moEmE2oqk1014ycje8CAnn3+66p2izW+47/Dv8NXn+Hqn39fo+Vqv8q/Q7ISu4
+Yii3iNy2JOk3ezs7y1z1tno91htwTiT6GOq7AguslGa4bHW9n6NxRUxrhg3srfD3oah1jaP5rLL5
+r7G4Im+8KCkztTV2dfY24K254235Gah4Obn62mv7fDz9tjf6Chiy+Ps+XO573qx6f///yH5BAEAA
+H8ALAAAAAASABIAAAf/gH+CghAwWkBAWjAQg42CAn1BPz4+P0FUAo6CHg4HeQohIQp5Bw4ejhkOF
+Vg4QhQUQjhWFaaDMB9QZyYUWQcHEhQmEVAfmX90UmG7EUQEBUQFMSZWJH53Agg2eDEfRCETE3BEE
+jFkNghuGggbY+AICCsrfkQkE21VZnVbLhsTNSs3ZnQxoEDBhRU1TtgxwGLJnRoBQYAoQYRPExAzb
+nxxcUUDAwAMuoAQMSAFkQUDRIAAU4QBixwjVJQYOQAFBy4oUKTkoGIEhj9OnujZUzOAyQ4BULzIY
+YGNoDsLGmB4EaCDlxRlkK5psADAIBUB0MiwoGbHjjRiZDQI8MZRiwQJLqb04MGjRxy4LRpBKAJhD
+o0hSJhEQTKEhpw/fAkpMfLgwREdSZLoONLYiBJGgQAAOw=="
+
+# checked icon for selection
+image create photo icon_checked -data "R0lGODlhDgAOAOcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4ODg
+8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEhIS
+IiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0ND
+U1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdHR0
+hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpaWl
+tbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1tbW
+5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CAgI
+GBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOTk5
+SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaampq
+enp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5ub
+q6uru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zMzM
+3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f3+
+Dg4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy8v
+Pz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///yH5BAEKAP8ALAAAAAAOAA4AAA
+h1AHcJHEiw4L+DCBOW8SEwocMyOwSg2uUQoRkEIUo1rHjigYBb/3aJCRBgFcIaAgScOrirTAAHcQ
+6WEHDAE8JdWgYIiPEvyIABhxLuyhNAAAIBAw7gcSiwjYAEDgrMqSjQWoAFAlRVDElRmQ9SW7mGFV
+qw7MCAADs="
+# unchecked icon for selection
+image create photo icon_unchecked -data "R0lGODlhDgAOAOcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4O
+Dg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEh
+ISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0
+NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdH
+R0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpa
+WltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1t
+bW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CA
+gIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOT
+k5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaam
+pqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5
+ubq6uru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zM
+zM3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f
+3+Dg4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy
+8vPz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///yH+GkNyZWF0ZWQgd2l0aCBH
+SU1QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAOAA4AAAgxAHcJHEiw4L+DCBMeFKiw4T+GDhNCjLhw
+F0WEEylmjLjRYceGHxWGlGjx4sOCKAcGBAA7"
+
+image create photo icon_checkedunchecked -data "R0lGODlhHgAOAOe8AAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4O
+Dg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEh
+ISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0
+NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdH
+R0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpa
+WltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1t
+bW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CA
+gIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOT
+k5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaam
+pqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5
+ubq6uru7u///////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////yH+GkNyZWF0ZWQgd2l0aCBH
+SU1QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAeAA4AAAicAHcJHEiQ4L9/BRMaPMiw4cFdDx06LOND
+oESJEBFePFhmhwBUGTdG1HjRDIIQpSyKHBmy4YkHAm4hbLkxo5gAAVYxrCFAwKmHNC9mLBPAQZyD
+JQQc8MRQ5cqMWgYIiPEvyIABhxo6FZkxTwABCAQMOIDH4daaD9sISOCgwByMQTE+tBZggQBVQuOa
+jajMB6maerWOfKpQIdDCBAMCADs="
+
+# clipboard icon
+image create photo icon_clipboard -data "R0lGODlhEgAVAOYAAOvr6peXimxEAm1EA1xcXMaHJ15eXu/v7unp59/Xz+jo5ubm42xFA+vr6cSH
+Jurq6OLb1KampcvLyezt7Ozs62loZ6l+Oufn5ebm5KWlpOXl4qampuTk4W1GA+Li4W1FA6Sko4+P
+g5CQhGtraufn5Lq6sO3t7H58e+7u7XRwZGhqZLGAMWlqZLuoj62uqnROEWJiYWNVO7a2sri4td3d
+3bl+IriliXhQEre3tHBuYndSFXNvYru7snRNDXJvY9bX05CQiry8sqyagOzs6nVxZNvb2MW/uLR7
+IqOjoaysqHNMDdvb2+rr6s3Nye7u7Lu7sWtFA8WHJ+Xl4+3t6+rq6bekiZBtNXp6c83OyndPEcHB
+vo2NiLh+I+Tk4sO9trqDLMCDJHdQEXt7dcvLx6SkonZQErq6sejo5a+vrOLi37W1sdbW1MWIJmNj
+YmNWPMWHJsWGJmZoZKenpm5GA+Pc1mxDAWhpZMSGJvDw7////wAAAAAAAAAAAAAAAAAAAAAAACH5
+BAAAAAAALAAAAAASABUAAAf/gHSCgycEhgQng4oQCQlGFQQhIiIhBBVejRB0Nj0MDDFXAaKjYm4M
+UEpVYWAWKTBbJSVmTzxBQG0pFlxZc2xEEzQjBsPEI0sTPg51cwUseXgHANLTB3h5dm/Lzc943d7d
+B9dw2irPcufochsm4uTc3wcoUwDtzHbm6BEZIGQI9QX3vB1wQqHBAwRF6kUJuEEfCCQIFJDAcu3O
+sjf3UJgYYlDBhQUaZlS8eK/gwTMYmmjBIWPkHIx5qEQksaALmjw48dix+PKeR5Ac0rh45mHNTpJ5
+MEjh8GOMmiR5PEiIs8Jihzc7mODcmnNqVatvrOSIQ7Zs2S930ta5UcMBnLdwF9LKlevgSJkWOj58
+GMBXgN+/fAe8EBIIADs="
+
+image create photo icon_palm -data "R0lGODlhFAAUAOeLACBYATZTCi1nAD1jBjFtA3phDkF2C0V4Dkl/BUx+CU2CBVWEAF2CBFWFBId1
+G1eHAFaHBF2KEoJ9KlqLFlyOCmKQCGGPIF6RFmSPGWWSCo6ASWWTCnOPGGeUE2eUImqXBGuUIG2Z
+CW6XK4SRQ3CbJ3GbLHOfInahDHefMHWhK3mjGXikFHuiH3mlDXqhNXqjInqnDX6lJn6kMr+SPsuR
+PoSrKIKpRIesI4awCoWuNYisRn+yMomvOIuxIoWxNYyyKtKaS4ywQo2zMJC2Lb2mTpG4HpK3LZS4
+LpS1TZK5MZS5NJa4PZe6J5e1YJe5S5u9Md6qY5nBT+KqXKLCOaHENaHCUqTFMaTAaqHFSabLH6TH
+TanJQeSzcNy4banOLqzId67OOa7MY7HLbrDOcK7Qf7bWPLjWR7rUYLfcL/HFkb/XgMDcUsDaZsPc
+XvjJisTYkfPLi8LgTMjgYMrhYfjPlMrggN/fldDobtHllv/XntPjrM3uUtzkmdPpjNXpjNXuZNDq
+pdrvc9nqr97xfub1j+v4mer8pOr9xvT/svv/w/r/4P//////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////yH+GkNyZWF0ZWQgd2l0aCBH
+SU1QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAUABQAAAjSAP8JHEiwoEGCheRMOchwICIqNwQ2WdKw
+oKEfKv6JUFOxzZMTHXRoGeICxRsbLLAYJDTnTJggFiasgOAhAoYXRsz8YdjHSQIBBBZkqOEn0b9B
+B5U8OGAAwIANJhqAaMjkAwkZCAI4YODjSokKB8HgqCIoiQIJMzhcwKMHSQyDWdgo+gcjBRE4Xyi0
+ECjG4B2BZYqM6UIHUAghFQXG8VJHiptDPY4kFoiGDxeBW6xM/rfHDhSBazYPBJLnXyDRAmmkQS1w
+RAENrP/tyMEjCpnYFQMCADs="
+
+# exit icon for close
+image create photo icon_exit -data "
+R0lGODlhMAAwAOcAAAAAAAEBAQICAgMDAwQEBAUFBQYGBgcHBwgICAkJCQoKCgsLCwwMDA0NDQ4O
+Dg8PDxAQEBERERISEhMTExQUFBUVFRYWFhcXFxgYGBkZGRoaGhsbGxwcHB0dHR4eHh8fHyAgICEh
+ISIiIiMjIyQkJCUlJSYmJicnJygoKCkpKSoqKisrKywsLC0tLS4uLi8vLzAwMDExMTIyMjMzMzQ0
+NDU1NTY2Njc3Nzg4ODk5OTo6Ojs7Ozw8PD09PT4+Pj8/P0BAQEFBQUJCQkNDQ0REREVFRUZGRkdH
+R0hISElJSUpKSktLS0xMTE1NTU5OTk9PT1BQUFFRUVJSUlNTU1RUVFVVVVZWVldXV1hYWFlZWVpa
+WltbW1xcXF1dXV5eXl9fX2BgYGFhYWJiYmNjY2RkZGVlZWZmZmdnZ2hoaGlpaWpqamtra2xsbG1t
+bW5ubm9vb3BwcHFxcXJycnNzc3R0dHV1dXZ2dnd3d3h4eHl5eXp6ent7e3x8fH19fX5+fn9/f4CA
+gIGBgYKCgoODg4SEhIWFhYaGhoeHh4iIiImJiYqKiouLi4yMjI2NjY6Ojo+Pj5CQkJGRkZKSkpOT
+k5SUlJWVlZaWlpeXl5iYmJmZmZqampubm5ycnJ2dnZ6enp+fn6CgoKGhoaKioqOjo6SkpKWlpaam
+pqenp6ioqKmpqaqqqqurq6ysrK2tra6urq+vr7CwsLGxsbKysrOzs7S0tLW1tba2tre3t7i4uLm5
+ubq6uru7u7y8vL29vb6+vr+/v8DAwMHBwcLCwsPDw8TExMXFxcbGxsfHx8jIyMnJycrKysvLy8zM
+zM3Nzc7Ozs/Pz9DQ0NHR0dLS0tPT09TU1NXV1dbW1tfX19jY2NnZ2dra2tvb29zc3N3d3d7e3t/f
+3+Dg4OHh4eLi4uPj4+Tk5OXl5ebm5ufn5+jo6Onp6erq6uvr6+zs7O3t7e7u7u/v7/Dw8PHx8fLy
+8vPz8/T09PX19fb29vf39/j4+Pn5+fr6+vv7+/z8/P39/f7+/v///yH+GkNyZWF0ZWQgd2l0aCBH
+SU1QIG9uIGEgTWFjACH5BAEKAP8ALAAAAAAwADAAAAj+AP8JHEiwoMGDCBMqLMjHkENCECNKnDho
+kCBAcxYqLLQo0aFCFgUJCkSypEmSgFL+6cMHDx0zGgkmcrQIkaNPpVCxUpXqVClSokJ98sRpUyZM
+lihRkuQo0SA9cdqY0RLT0SNHmGb12oXLFq1Yr1qx6llqlNBOmjIljdSoo6FBfdyQ2RJFoZ1GjCjV
++tUrly1ZsFyN9TkKFFFNlyhNgsRIkSFAfvTksTMHThosTHx0QLhIUaRcvnJ9dbWqJ6mzRi0tpono
+baDId+rIieOGTZoxVXjQOCgIUaNau27NelX6p1lPRhNPesQokSFCgvzsiT3nzZo0aM6YGfMFSY/d
+BQn+GXrVNVarVKaA/mrGbFmyZMWMFRs2TFiwX3y37nJlpwyZMGGAsQUXVAjBQ0F5/BHJLYCxgoop
+hXlyzT4UziPMKKxskw+FHOrjoT7ZyNEFF1tkkcUVWFRhxA83EMTHHq7I0soqhIFiCR7F8MNPPrJ0
+QUUVd4zTDz9DFklkNmtYoeSSVUxxxBA/EIRHIrOwcgqEQlEyxhXE6NgOHFiYiIUtRpaZDRsmppmF
+FVUoYYQQA7ExByauoCKKKIZhogYWXOq4jhpZaKEFFrCUSeSRaKp5YhVLPLmDQGrE4Ykqo3zyCVqL
+eKFFFsTsw089nZiohRvb8OMphTrqmI0bW7TqKhb+VjCRhBE+CIQGHJ2U8okmm2hiyR6takGMPhSq
+gwoecXRizDHMHoNMNfJQuKqrrp7YxBJIRPkPGm9oIsomllyi2hsjbtGpp/pwc8h2Y4jhrrtndBIP
+P9m8wUUX+OK7BRZOLJEEnNu2cYknl0giSSSOlMEFicNSmA4iWSws8cRgBLMPNvZOTGIW/SoBMBpu
+UKLJJI440lYYXozYMD2fePHFF/h64QUbdtAhBheEpIMNHDL37AUXWkDRhMe2vhGJJZAs0tghX8jc
+BTH3zBOLGE377IUg4qDjyIi9WANH1T13QdfQH7/xyCSLHIIISGCA8UUYlagCShsvv8HdF22jkYz+
+Ps6g4QUfysyBd9tt/xzFE0yU3cgjhwxCSCB/vIw3gGG8HAcxeUjuNify2GPJF2ewkrnkL/8sBeJl
+K7LIRa/tQXjbeHuRRjH0jDK423Fwk882jnTCDB2vw97F6YkXrTYgevShxx2Ei6FHIYZMYgw9+FSz
+BhiUg9FKPfjEI481cgT4OsxURNFE2RDtYUced9jsLhjCrMOOPPfkg488lbwrBhiMuGN/PtaYQxj0
+RzUfRcEJH4NDIADhEtnA4V1hGMY98EFBCtYDFe8aQxgEkY4KBpCA+/uCFQ5YBEjBwQ98mEMcaMMG
+CEqwgvi4R73ctZ0w8IEcFazGHECIvRE6oYT+/1ADHPagBzi0oTa3aVcE7zHBCcrjEwNEAyHKEAY7
+eCOG1dvhGLa4xTCQ4QokNKEe7LAGNKRBOxAUhj3WuEZuuI8PrDiDGOBgDTZSY4cgLAMWwhjEONwh
+DrcxQxm4KIYwCKMebJyHKcqwP1kIQw1iWMMz2HiNPDCSi+0qQxakAAUgRqoObijDF8TQrjQico3Y
+2GEYAmEOaTwwdM2I5TAqsQg8usuLe3yCJ+MgB0iOEpOFDEY9EPmOUYBhi7WwxznyEIYxgEFiXigD
+HiKRBlLu74tQ+CGk3vAGNOwPhGEABj3GmcpC2gEc9HCHIMAAQqpFBkBg8AIWOKnNbblBKt/+JGAY
+fjEPesRjFe0CAyrg4c9eCGIPCE2oZAihiQGGYXhPeAICBUIGNqyBDPEUH+G+8At5zKMbAgwDHa4x
+j5LCoxzjSGlKrZGIO7CPal+gixNmCjAxoAEN3OkCAd3WUXeQ4l2heIdHhzoPokLDDXh7mdu08IQm
+OIEJQxCIFsaAUXwFz22+iMc27NA2N0QjHmANq1jjAY04wK5pXcBCU58KBIEkQQskssIWgtc0X7yj
+FWtQwxpQsY6x+vUZcHBb1bjAryVcq0UCYUIUqCCFKriMdF3ARTuWkYlOpAIa54CHZjfLWXhQ42sp
+09cV+tWEJBAECEyIqBS64DN8zUEZ4HD+hNvEIAltuAMe78CtbnOrjlYoTGwlitUSmNBWgiCBCU14
+whZY67SmzcEY4tAEzLpgiGu447rYxW47ytGKMAANC1igAhOwZZAfJCG1WXDaiEbEBTkcIxyUmG4h
+rMGO7LqjHexghzrIsYowXKEK5RsvwApihCQ44QqsvYKCF3wFNeCCG5PogqD+QA11WNjC6UCHOcoh
+jmx0ogrjXUKjEBKDIpy3CliAQhSgwGIoPAEKbVDFJx4XiEKgohY4rgUtZiELsLRCFZkoQxKQoIQj
+zCAhMSDCEZQwXiWI+MnDbWwVpgxgKlh5ClOQgpZZHFFZHYEIR15ID5SMhCSY+cxoTrM+mo+AhCMc
+wQhGOEIRihuTf+xACEWAs573zOc+67kIRRjCgepcEBjgAAhDGAIQFs3oRju60TiAAaEnTemFBAQA
+Ow=="
+
+
+# plus icon
+image create photo icon_plus -data "
+R0lGODlhEwATAJEAAJmZmczMzGZmZv///yH5BAAAAAAALAAAAAATABMAAAJClI+Zwe3PDASUQvnA
+2OCKuQ3dgzka54Eo+VVV6FrSGdZ1N9s6mu823orBYoFSgzZyGBnIVAbmNEFZE1cUgi0qtooCADs="
+
+# minus icon
+image create photo icon_minus -data "
+R0lGODlhEwATAJEAAJmZmczMzGZmZv///yH5BAAAAAAALAAAAAATABMAAAI1lI+Zwe3PDJxOUmov
+zLqKvn3ASJZmIAHDyrYsgIruvMIpPduiyZMx+OAAhSBix6hBXhRMZgEAOw=="
+
+# folder icon
+image create photo icon_folder -data "
+R0lGODlhEAAQAOZ+AGFhYfDw8HFxceDg4LCwsICAgKCgoJCQkPzsXfjbRv73cfztX//80P/5nv/7
+xP/5mv/7wP/4hO/v7/70aVFRUfriT//4fP71a/72bv//+vjaRP/5p/rkU7+/v9/f3//4iP3zZ46I
+Of/6vP/++P/5kf/94f/6s5+fn+/qpHBtNXFwZf/3dO/obb2zSOnRR/ngTf/+8evaVP/5jXBwXvvo
+WP/83J+bWPrjUfvnVurTSf///r+7if/+9f/83f/4gf/5o//6r3FvZWBfTv/95a+vr//96d/e1f3x
+ZP/5lX5xJ4t4Iv///GBeVP/4gG1gJ/3yZnBwcPzrW//7yHFuQvvpWb++sNnBP8mxN5+ccYCActDQ
+0P/6uF5TGmFfUU9GILmfLIGBenBsWXFvWYGBgf3vYmBdSm9mJlBMOfvmVPzuYP/82P/7zP/5oo+P
+j761TP/82VFRS7qjM//5q//3eIGAf//+7frjUFBQUIGAevzqW4B/bP/81cDAwP///wAAAAAAACH5
+BAEAAH4ALAAAAAAQABAAAAfKgH6CggEHTIQGYU4Eg4IHXl9KBEFcVxoJZYMBZ3GXVkkuLxU3HGYB
+ghQ5FXYcaDg0VFEICy2MAwAxebNpZEdPIBMXGAVCISFuwMIKK3MWPhEfYDMKLCkWTdAyJEgPDT8b
+enw2JFPdbBtyQCZbIhAOWX5wKFg77Q5Sawx7bz0lKn4DxDDooqZGiSFF6sDgMSIDHUEFquAx0nCJ
+jj4Y+3QAMIiCBwEZM3a4U6CRFgFjPGQkAsBAo0EHTkiQ0Kbly5cCoAgYcLOnT0GBAAA7"
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions.tcl	(revision 4775)
@@ -0,0 +1,944 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+#################################################
+# need description
+#################################################
+proc debug {txt } {
+    global debug
+    if {$debug} {
+        log "$txt" "debug"
+    }
+}
+
+################################################
+# need description
+#################################################
+proc success {txt } {
+    global debug
+    if {$debug} {
+        log "$txt \n" "ok"
+    }
+}
+
+#################################################
+# need description
+#################################################
+proc warning {txt } {
+    log "$txt" "warning"
+}
+
+proc pause args {
+    set txt "Info : [join $args]"
+    tk_messageBox -type ok -title stop -message $txt 
+    # -parent .
+}
+
+proc font_create {} {
+    set graph_font [font create graph_font -family courrier -size 10 ]
+    set graph_fonttitle [font create graph_fonttitle -family courrier -size 12 -weight bold -underline true ]
+    set log_font [font create log_font -family courier -size 10 ]
+}
+
+proc log_create {} {
+    global engine_version waypoint workingDir log_channel
+    
+    
+    
+                     
+    
+    
+    
+    set waypoint 0
+    
+    
+    # fenetre log
+    ttk::frame .log -relief groove
+    pack .log -side bottom -fill x
+    set log_lines 7
+    
+    
+    set coltxt [ThemeColor 1.05]
+    text .log.text_log -height $log_lines -yscrollcommand {.log.ybar_log set} -wrap word -font log_font -background $coltxt -highlightcolor $coltxt -highlightbackground $coltxt -selectbackground skyblue1
+
+    bind .log.text_log <Enter> [subst { set tabscroll 0 }]
+    bind .log.text_log <Leave> [subst { set tabscroll 1 }]
+    
+  
+    
+    
+    ttk::scrollbar .log.ybar_log -orient vertical -command {.log.text_log yview}
+    
+    ttk::button .log.copy  -image icon_clipboard -command {
+        clipboard clear
+        clipboard append [.log.text_log get -- 1.0 end]
+        puts [.log.text_log get -- 1.0 end]
+    }
+    ttk::button .log.palm  -image icon_palm -command [subst {
+        .log.text_log configure -state normal
+        for {set i 0} {\$i< 5} {incr i} {
+            .log.text_log insert end "\n"
+        }
+        .log.text_log insert end "Waypoint \$waypoint" debug
+        incr waypoint
+        .log.text_log yview moveto 1.0
+        .log.text_log configure -state disabled
+    }]
+    ttk::button .log.zoom  -image icon_magnifierplus -command {
+        set curh [.log.text_log cget -height]
+        if {$curh == 7} {
+            .log.text_log configure -height 30
+            .log.zoom configure -image icon_magnifierminus
+        } else {
+            .log.text_log configure -height 7
+            .log.zoom configure -image icon_magnifierplus
+        }
+    }
+    
+    balloon .log.palm "Add some space and a numbered waypoint"
+    balloon .log.zoom "Increase/Decrease the size of the log"
+    balloon .log.copy "Copy log content to clipboard"
+    
+    # cartouche Identite
+    ttk::frame .log.id 
+    set username [getConfig "config id user name"]
+    set company [getConfig "config id user company"]
+    set logo "icon_$company"
+    if {$logo in [image names]} {
+        ttk::label .log.id.logo -image "icon_$company"
+    } else {
+        puts "Warning , image $logo does not exists"
+         ttk::label .log.id.logo
+    }
+    ttk::label .log.id.user -text $username
+    ttk::label .log.id.power -style "Multiple.TLabel"  -text "by Cerfacs" -image icon_gui_tiny -compound left -justify center
+    
+    pack .log.id.logo -side top -anchor center -padx 2
+    pack .log.id.user -side top -anchor center -padx 5
+    pack .log.id.power -side bottom -anchor center -padx 5
+    pack .log.id -side right -pady 2 -padx 2 -fill both
+    
+    
+    pack .log.text_log -fill both -side left -expand true -pady 2 -padx {2 0}
+    pack .log.ybar_log -side left -fill y -pady 2 -padx {0 2}
+    pack .log.copy -side bottom -pady 2
+    pack .log.palm -side bottom -pady 2
+    pack .log.zoom -side bottom -pady 2
+    
+    
+    
+    
+    
+    
+    
+    
+    log {.____   ____   ___   _  _   _____  ___     _   
+/ __ \ )  _)\ ) __( ) \/ ( )__ __() __(   )_\  
+))__(( | '__/ | _)  |  \ |   | |  | _)   /( )\ 
+\____/ )_(    )___( )_()_(   )_(  )___( )_/ \_(}
+    log "Version : $engine_version"
+     
+
+    .log.text_log tag configure none -foreground black
+    .log.text_log tag configure debug -foreground blue
+    .log.text_log tag configure ok -foreground green4
+    .log.text_log tag configure warning -foreground red
+    .log.text_log tag configure xdrerror -foreground red4
+    .log.text_log tag configure xdrexecute -foreground grey50
+    .log.text_log tag configure plugin -foreground violet
+    
+    
+}
+
+proc log {txt {tagid none}} {
+    global log_channel
+    
+    .log.text_log configure -state normal
+    .log.text_log insert end "\n$txt" $tagid
+    # limit the length of text
+    .log.text_log delete 1.0 end-4000lines
+    .log.text_log yview moveto 1.0
+    .log.text_log configure -state disabled
+    
+    puts $log_channel "$txt"
+    
+}
+
+#################################################
+# need description
+#################################################
+
+proc arginfo {level} {
+   set proc [lindex [info level [expr -1-$level]] 0]
+   set which [uplevel [list namespace which -command $proc]]
+   puts "proc \[$which\]"
+   set i -1
+   foreach arg [info args $which] {
+     incr i
+     set value [uplevel [expr 1+$level] [list set $arg] ]
+     if { [info default $which $arg def] } {
+       puts "  arg\[$i\] \[$arg\] = \[$value\] default = \[$def\]"
+     } else {
+       puts "  arg\[$i\] \[$arg\] = \[$value\]"
+     }
+   }
+ }
+
+#################################################
+# need description
+#################################################
+
+proc stackInfo {} {
+    puts ""
+    puts "====================================="
+    set levels [expr [info level]-1]
+    for {set i 0} {$i <= $levels} {incr i} {
+        arginfo $i
+    }
+    puts "====================================="
+    puts ""
+}
+
+
+
+proc exec_script {cmd} {
+    
+    set erreur [ catch {exec -ignorestderr {*}$cmd } err] 
+    if {$erreur} {
+        warning "Error file attempting to do : $cmd"
+        warning $err
+        return 0
+    }
+    return 1
+}
+
+
+#################################################
+# retrieve the current folder whatever the OS is
+##################################################
+
+proc osPwd {} {
+    # First try : UNIX
+    if {[catch {set result [exec {pwd}]}]} {
+        # Then : Windows
+        if {[catch {set result [exec {echo %cd%}]}]} {
+            # Unknown
+            error "System unknown"
+        }
+    }
+    return $result
+}
+
+proc copyFileInWkdir {path} {
+    global workingDir
+    set copiedfile [file tail $path]
+    
+    if {$copiedfile == $path} {
+    } else {
+        file copy -force $path [file join  $workingDir $copiedfile]
+    }
+    return $copiedfile
+}
+
+proc lremove {listVariable value} {
+    upvar 1 $listVariable var
+    set idx [lsearch -exact $var $value]
+    if {$idx != -1} { 
+        set var [lreplace $var $idx $idx]
+    }
+}
+
+# get the max and min of a list
+proc list_bounds {input {min 1e+40} {max -1e+40} } {
+    foreach item $input {
+        if {$item > $max} {set max $item}
+        if {$item < $min} {set min $item}
+        
+    }
+    return "$min $max"
+}
+
+
+
+
+##############################################################
+# Handle unexpected errors in the tcl/tk code with a message #
+# Replace the default tk procedure that display a code error #
+##############################################################
+proc bgerror {error} {
+    global errorInfo conf engine_version
+    # Save the stack error message and save it in an error file with the time and configuration information
+    set bugReport $errorInfo 
+    
+    set current_dir [pwd]
+    set bugFilePath [file join $current_dir "bug_Report.txt"]
+    set bugFile [open $bugFilePath w]
+    puts $bugFile "Error generated the [clock format [clock seconds] -format {%b. %d, %Y %I:%M:%S %p}]"
+    puts $bugFile "Stack report:"
+    puts $bugFile "$bugReport"
+    puts $bugFile "-----------------------------------------------"
+    puts $bugFile "User configuration:"
+    foreach var [array names conf] {
+        puts $bugFile "$var : $conf($var)"
+    }
+    close $bugFile
+
+    # Display a pop up for the user
+    set win ".error"
+    set ierror 0
+
+    
+    if {[winfo exists $win]} {
+        destroy $win
+    } 
+
+    toplevel $win
+    wm title $win "Internal error"
+    
+    
+    ttk::frame $win.f
+    pack $win.f
+    
+    ttk::label  $win.f.mess -text "Internal error: \n $error" -image icon_garfield -compound left
+    
+    
+    ttk::frame $win.f.report
+    text $win.f.report.txt -yscrollcommand [list $win.f.report.sby set]  -width 70 -height 10 -wrap word
+    ttk::scrollbar $win.f.report.sby -orient vertical -command [list $win.f.report.txt  yview]
+    $win.f.report.txt insert end  "engine : $engine_version \n \n  $bugReport" 
+    grid $win.f.report.txt -row 0 -column 0 -sticky news
+    grid $win.f.report.sby -row 0 -column 1 -sticky news
+    
+    
+    ttk::separator $win.f.sep 
+    ttk::label $win.f.panel -text "This error is not handled . Contact the person in charge on your site\n On his/her behalf, post a full description on how it happened plus the file:\n $bugFilePath \n " -justify center
+    pack $win.f.mess -pady 20
+    pack $win.f.report -pady 10
+    pack $win.f.sep -fill x
+    pack $win.f.panel -pady 20
+    
+    raise $win .
+
+}
+
+
+
+
+proc balloon {w help} {
+    bind $w <Any-Enter> "after 500 [list balloon:show %W [list $help]]"
+    bind $w <Any-Leave> "destroy %W.balloon"
+}
+
+proc balloon:show {w arg} {
+    if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
+    set top $w.balloon
+    catch {destroy $top}
+    toplevel $top -bd 1 -bg black
+    wm overrideredirect $top 1
+    
+    if {[string equal [tk windowingsystem] aqua]}  {
+        ::tk::unsupported::MacWindowStyle style $top help none
+    }   
+    pack [message $top.txt -aspect 10000 -bg lightyellow \
+            -font fixed -text $arg]
+    set wmx [winfo rootx $w]
+    set wmy [expr [winfo rooty $w]+[winfo height $w]]
+    wm geometry $top \
+      [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
+    raise $top
+}
+
+proc split_list {L} {
+    
+    set len [expr {int(0.5*[llength $L])}]
+    set A ""
+    set B ""
+    for {set i 0} {$i< $len} {incr i} {
+        lappend A [lindex $L [expr {$i*2}]]
+        lappend B [lindex $L [expr {$i*2+1}]]
+    }
+    return "{$A} {$B}"
+}
+
+proc get_keys_listcsv {L} {
+    
+    set L [split $L ";"]
+    set len [expr {int(0.5*[llength $L])}]
+    set A ""
+    for {set i 0} {$i< $len} {incr i} {
+        lappend A [lindex $L [expr {$i*2}]]
+    }
+    return $A 
+}
+
+proc get_values_listcsv {L} {
+    set L [split $L ";"]
+    set len [expr {int(0.5*[llength $L])}]
+    set A ""
+    for {set i 0} {$i< $len} {incr i} {
+        lappend A [lindex $L [expr {$i*2+1}]]
+    }
+    return $A
+}
+
+proc keyvalue_listcsv {L} {
+    set L [split $L ";"]
+    set len [expr {int(0.5*[llength $L])}]
+    set A ""
+
+    for {set i 0} {$i< $len} {incr i} {
+        lappend A "[lindex $L [expr {$i*2}]] [lindex $L [expr {$i*2+1}]]"
+    }
+    return $A
+}
+
+# to  limit  huge chunks of text
+proc limit_string {str max} {
+    set str2 $str
+    set bit [expr {int(0.5*$max)}]
+    if {[string length $str] >$max} {
+        set str2 "[string range $str 0 $bit](...) [string range $str end-$bit end] "
+    }
+    return $str2
+}
+
+#to get the parent of a dot  separated  string
+proc crop_address {adr levels} {
+    set ladr [split $adr "."]
+    set end_adr [expr {[llength $ladr] - $levels -1 }]
+    
+    if {$end_adr <0 } {
+        error "crop_address cannot crop $levels levels from $adr"
+        return
+    }
+    set new_adr [join [lrange $ladr 0 $end_adr] "."]
+    return $new_adr
+}
+
+
+proc canvas_text_vector {w x y txt pos size rotate color tags} {
+    
+    set hsize [expr {0.7 *$size}]
+    set csize [expr {0.7 *$hsize}]
+    
+    set slant 0.0
+    set rotate [expr {$rotate*1./180*3.1415}]
+    
+    set txtl [split  $txt ""]
+    
+    set ltxt [llength $txtl]
+    set wtxt [expr {$ltxt*$hsize}]
+    
+    set x0 $x
+    set y0 $y
+   
+    
+    
+    
+    
+    switch $pos {
+        "center" {
+            set xstart [expr {-$wtxt*0.5}]
+            set ystart [expr {-$size*0.5}]
+        }
+        "ne" {
+            set xstart [expr {+$wtxt*0.1}]
+            set ystart [expr {+$size*0.1}]
+        }
+        "e" {
+            set xstart [expr {+$wtxt*0.1}]
+            set ystart [expr {-$size*0.5}]
+        }
+        "se" {
+            set xstart [expr {+$wtxt*0.1}]
+            set ystart [expr {-$size*1.1}]
+        }
+        "nw" {
+            set xstart [expr {-$wtxt*1 -$size*0.1}]
+            set ystart [expr {+$size*0.1}]
+        }
+        "w" {
+            set xstart [expr {-$wtxt*1 -$size*0.1}]
+            set ystart [expr {-$size*0.5}]
+        }
+        "sw" {
+            set xstart [expr {-$wtxt*1 -$size*0.1}]
+            set ystart [expr {-$size*1.1}]
+        }
+    }
+    
+    foreach char $txtl {
+        switch $char {
+            
+            "0" {set draw {{0.7 0} {1 0.3}  {1 0.7} {0.7 1} {0.7 1} {0.3 1} {0 0.7} {0 0.3} {0.3 0} {0.7 0}  {0.3 1}}}
+            "1" {set draw {{0.1 0} {0.9 0} {0.5 0} {0.5 1} {0.2 0.7}}}
+            "2" {set draw {{1 0} {0 0} {1 0.7} {0.7 1} {0.7 1} {0.3 1} {0 0.7}}}
+            "3" {set draw {{0 0} {0.7 0} {1 0.3} {0.8 0.6} {0.5 0.6} {0.8 0.6} {1 0.7} {1 0.8} {0.8 1} {0.7 1} {0 1} }}
+            "4" {set draw {{0.7 0} {0.7 1} {0 0.3} {1 0.3} }}
+            "5" {set draw {{1 1} {0 1} {0 0.55} {1 0.55} {1 0.2} {0.8 0} {0 0}}}
+            "6" {set draw {{0.9 1} {0.3 1} {0 0.7} {0 0.2} {0.2 0} {0.8 0} {1 0.2} {1 0.4} {0.8 0.5} {0 0.5}}}
+            "7" {set draw {{0 0} {0 0.2} {1 1} {0 1} {0 0.9}}}
+            "8" {set draw {{0.7 0} {1 0.3} {1 0.4} {0.1 0.7} {0.1 0.8} {0.3 1} {0.7 1} {0.9 0.8} {0.9 0.7}  {0 0.4} {0 0.3} {0.3 0} {0.7 0}}}
+            "9" {set draw {{0 0} {0.80 0} {1 0.2} {1 0.8} {0.8 1} {0.2 1} {0 0.8} {0 0.6} {0.1 0.5} {1 0.5} }}
+            "A" {set draw {{0 0} {0.5 1} {0.75 0.5} {0.25 0.5} {0.75 0.5} {1 0} }}
+            "a" {set draw {{1 0} {1 0.7} {0.2 0.7} {0 0.5} {0 0.1} {0.1 0} {0.9 0} {1 0.1} }}
+            "B" {set draw {{0 0.5} {0.8 0.5} {1 0.7} {1 0.8} {0.8 1} {0 1} {0 0} {0.8 0} {1 0.2} {1 0.3} {0.8 0.5} }}
+            "b" {set draw {{0 1} {0 0} {0.8 0} {1 0.1} {1 0.5} {0.5 0.7} {0 0.5}}}
+            "C" {set draw {{1 1} {0.2 1} {0 0.8} {0 0.2} {0.2 0} {1 0}}}
+            "c" {set draw {{1 0.7} {0.2 0.7} {0 0.5} {0 0.2} {0.2 0} {1 0}}}
+            "D" {set draw {{0 1} {0 0} {0.8 0} {1 0.2} {1 0.8} {0.8 1} {0 1}}}
+            "d" {set draw {{1 1} {1 0} {1 0.1} {0.9 0} {0.2 0} {0 0.2} {0 0.4} {0.5 0.7} {1 0.7}}}
+            "E" {set draw {{1 0} {0 0} {0 0.5} {0.4 0.5} {0 0.5} {0 1} {1 1} }}
+            "e" {set draw {{0 0.35} {1 0.35} {1 0.5} {0.8 0.7} {0.2 0.7} {0 0.5} {0 0.2} {0.2 0} {1 0}}}
+            "F" {set draw {{0 0} {0 0.5} {0.4 0.5} {0 0.5} {0 1} {1 1} }}
+            "f" {set draw {{0.5 0} {0.5 0.7} {0 0.7} {1 0.7} {0.5 0.7} {0.5 0.8} {0.8 1} {1 1} }}
+            "G" {set draw {{1 1} {0.2 1} {0 0.8 } {0 0.2} {0.2 0} {1 0} {1 0.5} {0.8 0.5} }}
+            "g" {set draw {  {0 -0.1} {0.2 -0.3} {0.8 -0.3} {1 -0.1} {1 0.7} {0.3 0.7} {0 0.3} {0 0.3} {0.3 0} {0.8 0} {1 0.2}  }}
+            "H" {set draw {{0 0} {0 1} {0 0.5} {1 0.5} {1 1} {1 0}}}
+            "h" {set draw {{0 1} {0 0} {0 0.5} {0.5 0.7} {0.8 0.7} {1 0.5} {1 0}}}
+            "I" {set draw {{0.3 0} {0.7 0} {0.5 0} {0.5 1} {0.7 1} {0.3 1}}}
+            "i" {set draw {{0.3 0.7} {0.5 0.7} {0.5 0} {0.8 0}}}
+            "J" {set draw {{0 0} {0.5 0} {0.7 0.2} {0.7 1} {0.5 1} }}
+            "j" {set draw {{0.1 0.7} {0.7 0.7} {0.7 -0.1} {0.5 -0.3} {0 -0.3}}}
+            "K" {set draw {{0 0} {0 1} {0 0.6} {1 0} {0 0.6} {1 1} }}
+            "k" {set draw {{0 0} {0 1} {0 0.4} {1 0} {0 0.4} {1 0.7}}}
+            "L" {set draw {{0 1} {0 0} {1 0}}}
+            "l" {set draw {{0.3 1} {0.5 1} {0.5 0} {0.8 0}}}
+            "M" {set draw {{0 0} {0 1} {0.5 0.3} {1 1} {1 0}}}
+            "m" {set draw {{0 0} {0 0.7} {0 0.5} {0.5 0.7} {0.5 0} {0.5 0.5} {0.8 0.7} {1 0.5} {1 0}}}
+            "N" {set draw {{0 0} {0 1}  {1 0} {1 1} }}
+            "n" {set draw {{0 0} {0 0.7} {0 0.5} {0.8 0.7} {1 0.5} {1 0}  }}
+            "O" {set draw {{0.7 0} {1 0.3}  {1 0.7} {0.7 1} {0.7 1} {0.3 1} {0 0.7} {0 0.3} {0.3 0} {0.7 0}}}
+            "o" {set draw {{0.7 0} {1 0.3}  {1 0.5} {0.7 0.7} {0.7 0.7} {0.3 0.7} {0 0.5} {0 0.3} {0.3 0} {0.7 0}}}
+            "P" {set draw {{0 0} {0 1}  {0.8 1} {1 0.8} {1 0.7} {0.8 0.5} {0 0.5}}}
+            "p" {set draw {{0 0.7} {0 -0.3}  {0 0} {0.8 0} {1 0.2} {1 0.5} {0.5 0.7} {0 0.5}}}
+            "Q" {set draw {{0.7 0} {1 0.3}  {1 0.7} {0.7 1} {0.7 1} {0.3 1} {0 0.7} {0 0.3} {0.3 0} {0.7 0} {0.9 -0.2}}}
+            "q" {set draw {{1 -0.3} {1 0.7} {0.2 0.7} {0 0.5} {0 0.1} {0.1 0} {0.9 0} {1 0.1} }}
+            "R" {set draw {{0 0} {0 1}  {0.8 1} {1 0.8} {1 0.7} {0.8 0.5} {0 0.5} {1 0} }}
+            "r" {set draw {{0 0.7} {0 0}  {0 0.5} {0.5 0.7} {1 0.7} {1 0.5}}}
+            "S" {set draw {{0 0} {0.8 0}  {1 0.2} {1 0.3} {0 0.7} {0 0.8} {0.2 1} {1 1}}}
+            "s" {set draw {{0 0} {0.8 0}  {1 0.2} {1 0.3} {0 0.5} {0 0.6} {0.2 0.7} {1 0.7}}}
+            "T" {set draw {{0.5 0} {0.5 1}  {1 1} {0 1}}}
+            "t" {set draw {{0 0.7} {0.8 0.7}  {0.4 0.7} {0.4 1} {0.4 0.2} {0.6 0} {1 0}}}
+            "U" {set draw {{0 1} {0 0.2}  {0.2 0} {0.8 0} {1 0.2} {1 1}}}
+            "u" {set draw {{0 0.7} {0 0.2}  {0.2 0} {0.8 0} {1 0.2} {1 0.7} {1 0}}}
+            "V" {set draw {{0 1} {0.5 0}  {1 1} }}
+            "v" {set draw {{0 0.7} {0.5 0}  {1 0.7} }}
+            "W" {set draw {{0 1} {0.3 0}  {0.5 1} {0.7 0} {1 1}}}
+            "w" {set draw {{0 0.7} {0.3 0}  {0.5 0.7} {0.7 0} {1 0.7}}}
+            "X" {set draw {{0 0} {1 1}  {0.5 0.5} {1 0} {0 1}}}
+            "x" {set draw {{0 0} {1 0.7}  {0.5 0.35} {1 0} {0 0.7}}}
+            "Y" {set draw {{0.5 0} {0.5 0.6}  {0 1} {0.5 0.6} {1 1}}}
+            "y" {set draw {{0 0.7} {0.5 0}  {1 0.7} {0.4 -0.1} {0 -0.3}}}
+            "Z" {set draw {{1 0} {0 0}  {1 1} {0 1}}}
+            "z" {set draw {{1 0} {0 0}  {1 0.7} {0 0.7}}}
+            "," {set draw {{0.7 0.20} {0.7 0} {0.9 -0.3} }}
+            "." {set draw {{0.7 0.20} {0.7 0} }}
+            "+" {set draw {{0.1 0.5} {0.9 0.5} {0.5 0.5} {0.5 0.2} {0.5 0.8} }}
+            "-" {set draw {{0.1 0.5} {0.9 0.5}}}
+            "(" {set draw { {0.7 1} {0.3 1} {0 0.7} {0 0.3} {0.3 0} {0.7 0}  }}
+            ")" {set draw { {0.3 1} {0.7 1} {1 0.7} {1 0.3} {0.7 0} {0.3 0}  }}
+            "[" {set draw { {0.7 1} {0 1} {0 0} {0.7 0} }}
+            "]" {set draw { {0.3 1} {1 1} {1 0} {0.3 0} }}
+            
+            default {set draw ""}
+        }
+        set line ""
+        foreach point $draw {
+            set xx [expr { [lindex $point 0] * $csize } ]
+            set yy [expr { ( 1. - [lindex $point 1] ) * $size } ]
+            
+            set x1 [expr { $xstart + $xx - $slant*$yy }]
+            set y1 [expr { $ystart + $yy }]
+            
+            set x2 [expr {$x0+cos($rotate)*$x1 + sin($rotate)*$y1} ]
+            set y2 [expr {$y0-sin($rotate)*$x1 + cos($rotate)*$y1} ]
+            
+            
+            lappend line $x2
+            lappend line $y2
+        }
+        if {$draw != ""} {
+        $w create line  $line -fill $color -width 1 -tags $tags
+        }
+        set xstart [expr { $xstart + $hsize }]
+        
+        #set ystart [expr { $ystart - sin($rotate)*$hsize + cos($rotate)*$size}]
+    }
+    
+}
+
+proc canvas_makegif2 {win filename} {
+    global widgetInfo
+    
+    $win delete pointer
+    set bbox [ $win bbox all]
+    if {$bbox == ""} {return}
+    set x0 [lindex $bbox 0]
+    set y0 [lindex $bbox 1]
+    set x1 [lindex $bbox 2]
+    set y1 [lindex $bbox 3]
+    
+    set nx [expr {int ($x1 -$x0)}]
+    set ny [expr {int ($y1 -$y0)}]
+     
+    image create photo fooble -width $nx -height $ny
+    fooble blank
+    foreach item [$win find all] {
+        set rawcol [$win itemcget $item -fill]
+        if {$rawcol == ""} {
+            set rawcol [$win itemcget $item -outline]
+        }
+        if {$rawcol != ""} {
+            set color [eval format "#%04x%04x%04x" [winfo rgb . $rawcol]]
+            set type [$win type $item ]
+            
+            switch $type {
+                "line" {
+                    set coords [$win coords $item]
+                    set xi0 [expr {([lindex $coords 0])}]
+                    set yi0 [expr {([lindex $coords 1])}]
+                    foreach {xi1 yi1} $coords {
+                        set dx [expr {$xi1-$xi0}]
+                        set dy [expr {$yi1-$yi0}]
+                        set adx [expr {abs($dx)}]
+                        set ady [expr {abs($dy)}]
+                        if {$dx>0} {
+                                set stepx 1
+                        } else {
+                                set stepx -1
+                        }
+                        if {$dy>0} {
+                                set stepy 1
+                        } else {
+                                set stepy -1
+                        }
+                            
+                        if { $adx > $ady} {
+                            if {$adx > 1} {
+                                if {$stepx == 1} {
+                                for {set x [expr {int($xi0)}]} {$x <$xi1} {incr x 1} {
+                                    set y [expr {int($yi0 + ($x - $xi0)/($xi1-$xi0) * ($yi1-$yi0))}]
+                                    fooble put $color -to [expr {($x-$x0)}] [expr {($y-$y0)}]
+                                }
+                                } else {
+                                  for {set x [expr {int($xi1)}]} {$x <$xi0} {incr x 1} {
+                                    set y [expr {int($yi0 + ($x - $xi0)/($xi1-$xi0) * ($yi1-$yi0))}]
+                                    fooble put $color -to [expr {($x-$x0)}] [expr {($y-$y0)}]
+                                }  
+                                }
+                            }
+                        }          
+                        if {$ady > $adx } {
+                            if {$ady > 1} {
+                                if {$stepy == 1} {
+                                    for {set y [expr {int($yi0)}]} {$y <$yi1} {incr y 1} {
+                                        set x [expr {int($xi0 + ($y - $yi0)/($yi1-$yi0) * ($xi1-$xi0))}]
+                                         fooble put $color -to [expr {($x-$x0)}] [expr {($y-$y0)}]
+                                    }
+                                } else {
+                                    for {set y [expr {int($yi1)}]} {$y <$yi0} {incr y 1} {
+                                        set x [expr {int($xi0 + ($y - $yi0)/($yi1-$yi0) * ($xi1-$xi0))}]
+                                         fooble put $color -to [expr {($x-$x0)}] [expr {($y-$y0)}]
+                                    }
+                                    
+                                }
+                            }
+                        }
+                                      
+                        set xi0 $xi1
+                        set yi0 $yi1
+                    }
+                }
+                "oval" {
+                    set coords [$win coords $item]
+                    set xmin [lindex $coords 0]
+                    set ymin [lindex $coords 1]
+                    set xmax [lindex $coords 2]
+                    set ymax [lindex $coords 3]
+                    set xmid [expr {(0.5*($xmax+$xmin))}]
+                    set ymid [expr {(0.5*($ymax+$ymin))}]
+                    set dx  [expr {($xmax-$xmin)}]
+                    set rad  [expr {(0.5*$dx)}]
+                    set hrad [expr {(0.36*$dx)}]
+                    fooble put  $color -to [expr {int($xmid-$hrad-$x0)}] [expr {int($ymid-$hrad-$y0)}] [expr {int($xmid+$hrad-$x0)}] [expr {int($ymid+$hrad-$y0)}] 
+                    
+                    #for {set x [expr {int(-$hrad)}] } {$x <=$hrad} {incr x} {
+                    #    for {set y [expr {int($hrad)}] } {$y <= $rad} {incr y} {
+                    #        #puts "here $x $y"
+                    #        set radius [expr {$x*$x+$y*$y}]
+                    #        if {$radius < [expr {$rad*$rad}]} {
+                    #            fooble put $color -to [expr {int($xmid+$x-$x0)}] [expr {int($ymid+$y-$y0)}]
+                    #            fooble put $color -to [expr {int($xmid+$x-$x0)}] [expr {int($ymid-$y-$y0)}]
+                    #            fooble put $color -to [expr {int($xmid+$y-$x0)}] [expr {int($ymid+$x-$y0)}]
+                    #            fooble put $color -to [expr {int($xmid-$y-$x0)}] [expr {int($ymid+$x-$y0)}]
+                    #        }
+                    #    }    
+                    #}   
+                }
+                "default" {
+                    set bbox [$win bbox $item]
+                    set xi0 [lindex $bbox 0]
+                    set yi0 [lindex $bbox 1]
+                    set xi1 [lindex $bbox 2]
+                    set yi1 [lindex $bbox 3]
+                    canvas_makegif_scan $win $xi0 $xi1 $yi0 $yi1 $x0 $y0
+                }
+            }
+            #switch $type {
+            #    "oval" {
+            #        
+            #        set coords [$win coords $item]
+            #        set xmin [lindex $coords 0]
+            #        set ymin [lindex $coords 1]
+            #        set xmax [lindex $coords 2]
+            #        set ymax [lindex $coords 3]
+            #        fooble put  $color -to [expr {int($xmin-$x0)}] [expr {int($ymin-$y0)}] [expr {int($xmax-$x0)}] [expr {int($ymax-$y0)}]
+            #    }
+            #    "line" {
+            #        set coords [$win coords $item]
+            #        
+            #        fooble put  blue -to [expr {int($xmin-$x0)}] [expr {int($ymin-$y0)}] [expr {int($xmax-$x0)}] [expr {int($ymax-$y0)}]
+            #    }
+            #}
+        }
+    }
+    fooble write $filename -format gif
+    puts "Done..."
+}
+
+
+
+proc canvas_makegif {win filename} {
+    global widgetInfo
+    
+    $win delete pointer
+    set bbox [ $win bbox all]
+    if {$bbox == ""} {return}
+    set x0 [lindex $bbox 0]
+    set y0 [lindex $bbox 1]
+    set x1 [lindex $bbox 2]
+    set y1 [lindex $bbox 3]
+    
+    set nx [expr {int ($x1 -$x0)}]
+    set ny [expr {int ($y1 -$y0)}]
+     
+    image create photo fooble -width $nx -height $ny
+    fooble blank
+    canvas_makegif_iterate $win $x0 $x1 $y0 $y1 $x0 $y0 
+    fooble write $filename -format gif
+    image delete fooble
+    #puts "Done..."
+}
+
+proc canvas_makegif_scan {win xmin xmax ymin ymax x0 y0 } {
+    set item [$win find overlapping $xmin $ymin $xmax $ymax]
+    if {$item == ""} {
+    #    #debug "Skipping square  $square"
+        return
+    }
+    
+    set multipleitem 1
+    
+    if {[llength $item] == 1} {
+        set rawcol [$win itemcget $item -fill]
+        if {$rawcol == ""} {
+            set rawcol [$win itemcget $item -outline]
+        }
+        if {$rawcol != ""} {
+            set color [eval format "#%04x%04x%04x" [winfo rgb . $rawcol]]
+            set multipleitem 0
+            #fooble put  $color -to [expr {$xmin-$x0}] [expr {$ymin-$y0}] [expr {$xmax-$x0}] [expr {$ymax-$y0}]
+        } else {
+            #set color ""
+            #nocolor for single item, skip
+            return
+        } 
+    }
+    
+    for {set x $xmin} {$x<=$xmax} {incr x} {
+        for {set y $ymin} {$y<=$ymax} {incr y} {
+            set item [$win find overlapping $x $y $x $y]
+            if {$item != ""} {
+                
+                if {$multipleitem} {
+                    set item [lindex $item end]
+                    set rawcol [$win itemcget $item -fill]
+                    if {$rawcol == ""} {
+                        set rawcol [$win itemcget $item -outline]
+                    }
+                    if {$rawcol != ""} {
+                        set color [eval format "#%04x%04x%04x" [winfo rgb . $rawcol]]
+                    } else {
+                        set color ""
+                    }
+                }
+                if {$color != ""} {
+                    fooble put  $color -to [expr {$x-$x0}] [expr {$y-$y0}]
+                }
+            }
+        }
+    }
+}
+
+proc canvas_makegif_iterate {win xmin xmax ymin ymax x0 y0 } {
+    set item  [$win find overlapping $xmin $ymin $xmax $ymax] 
+
+    if {$item== ""} {
+        #debug "Skipping square  $square"
+        return
+    }
+   
+    set xmid [expr {int (0.5*($xmax+$xmin))}]
+    set ymid [expr {int (0.5*($ymax+$ymin))}]
+    
+    set xmidp1 [expr {$xmid+1}]
+    set ymidp1 [expr {$ymid+1}]
+    
+    if { [expr ($ymid-$ymin)]> 2} {
+        canvas_makegif_iterate $win $xmin $xmid $ymin $ymid $x0 $y0 
+        canvas_makegif_iterate $win $xmin $xmid $ymidp1 $ymax $x0 $y0 
+        canvas_makegif_iterate $win $xmidp1 $xmax $ymin $ymid $x0 $y0 
+        canvas_makegif_iterate $win $xmidp1 $xmax $ymidp1 $ymax $x0 $y0 
+    } else {
+        canvas_makegif_scan $win $xmin $xmax $ymin $ymax $x0 $y0
+    }
+    return
+}
+
+
+# function to create a text on a canvas with surrounding white
+proc canvas_text_highlighted {wincan x y  txt tags} {
+    set bbox [$wincan bbox all]
+    set midx [expr {0.5*([lindex $bbox 0]+[lindex $bbox 2])}]
+    set midy [expr {0.5*([lindex $bbox 1]+[lindex $bbox 3])}]
+    
+    if {$x>$midx} {
+        set dx -5
+        set posx e
+    } else {
+        set dx 5
+        set posx w
+    }
+    if {$y>$midy} {
+        set dy -5
+        set posy s
+    } else {
+        set dy 5
+        set posy n
+    }
+    
+    set anchor "$posy$posx"
+    
+    $wincan create text [expr {$dx+$x-1}] [expr {$dy+$y-1}] -text $txt -tags $tags -anchor $anchor -fill white
+    $wincan create text [expr {$dx+$x+1}] [expr {$dy+$y-1}] -text $txt -tags $tags -anchor $anchor -fill white
+    $wincan create text [expr {$dx+$x-1}] [expr {$dy+$y+1}] -text $txt -tags $tags -anchor $anchor -fill white
+    $wincan create text [expr {$dx+$x+1}] [expr {$dy+$y+1}] -text $txt -tags $tags -anchor $anchor -fill white
+    $wincan create text [expr {$dx+$x}]   [expr {$dy+$y}]   -text $txt -tags $tags -anchor $anchor -fill black
+}
+
+
+proc commify {num {sep ,}} {
+    while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
+    return $num
+}
+
+
+proc printtime { start stop } {
+    return [format "%0.3f" [expr { ($stop - $start)*0.001 }]]
+}
+
+proc stringclean { str } {
+    set str_c [string map {"Ã " "a" "Ã§" "c" "Ã©" "e" "Ãš" "e" "Ã¹" "u" "Ãº" "u" "Ã¢" "a" "\t" " " ">" ".gt." "<" ".lt."} $str ]
+    return $str_c
+}
+
+proc stringcleanBalise { str } {
+    set str_c [stringclean $str]
+    # no spaces or operands
+    set str_c [string map {" " "_" "*" "times" "+" "plus" "/" "divide" "\}" "\)" "\{" "\(" "%" "" "!" "" "?" ""} $str_c ]
+    return $str_c
+}
+
+
+
+proc string2latex { str } {
+    set str_c [string map {"Ã " "\\`{a}" "Ã§" "\\c{c}" "Ã©" "\\'{e}" "Ãš" "\\`{e}" "Ã¹" "\\`{u}" "Ãº" "\\'{u}" } $str ]
+    return $str_c
+}
+
+# return a random integer between min and max
+proc myRand { min max } {
+    set value [ expr {int(rand() * ($max - $min)) + $min}]
+    return $value
+}
+
+# EASTER EGG
+proc random_msg {} {
+    set messages ""
+    
+    # envoie un message une fois sur dix seulement
+    if {[myRand 1 100] > 10 } { return ""}
+    
+    lappend messages "Get outta here and go back to your boring programs."
+    lappend messages "Just leave. When you come back, i'll be waiting with a bat."
+    lappend messages "You're lucky i don't smack you for thinking about leaving."
+    # TP spirit
+    lappend messages "Vous avez verifie les bilans du calcul ? (T.P.)"
+    lappend messages "Sur 100 calculs faux, 90 n'ont pas le bon point de fonctionnement, et 9 n'ont pas la bonne geometrie. (T.P.)"
+    lappend messages "Si on a le bon signe et la bonne dimension, alors c'est un bon modele. (T.P.)"
+    lappend messages "On ne change qu'un parametre a la fois. Un seul. Pas d'exceptions. (T.P.)"
+    lappend messages "Il vaut mieux un qui sait que dix qui cherchent (T.P.)"
+    
+    lappend messages "Est ce que vous avez verifiÃ© Shannon? Tout est dans Shannon. (V.M.)"
+    
+    lappend messages "B****l de b**e (H.D.)"
+    
+    lappend messages "The answer is 42."
+    lappend messages "He's dead, Jim!"
+    lappend messages "Si vous pouvez lire ceci, c'est que vous n'avez probablement pas assez de travail."
+    lappend messages "Dans simuler, y a -muler"
+    #lappend messages "Je ne peux pas donner la seule chose que j'ai a vendre (Mestre Grrincha)"
+    lappend messages "Tout calcul a le droit dâÃªtre prÃ©sumÃ© juste tant quâil nâest pas dÃ©clarÃ© faux, conformÃ©ment Ã  la loi, par un tribunal indÃ©pendant et impartial Ã  lâissue dâun procÃšs public et Ã©quitable. "
+    lappend messages "La ou s'abat le dÃ©sespoir, s'eleve la victoire des persÃ©verants (Thomas Sankara)"
+    
+    
+    
+    set max_index [expr {[llength $messages]-1}]
+    set msg [lindex $messages [myRand 0 $max_index] ]
+    return $msg
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_help.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_help.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_help.tcl	(revision 4775)
@@ -0,0 +1,812 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc generate_help_html { } {
+    global XMLtree  help_name help_rootdir help_level
+    
+    set msgOpen "Choose location to save help document (images saved in the same folder)"
+    
+    set help_dir [file join [file normalize $help_rootdir ] "help_openTea_$help_name"]
+    
+    file delete -force $help_dir
+    file mkdir $help_dir
+    
+    set help_file [file join $help_dir "help_openTea_$help_name.html"]
+    
+    
+
+    
+    
+    # gradient colors
+    set col1 "#c1c1c1"
+    set col0 "#ffffff"
+    
+    # theme color
+    set colA "#6E6E6E"
+    set colB "#0B610B"
+    
+    set dir "left"
+    switch $dir {
+        "top" {
+            set dir_webkit "0% 0%,0% 100%"
+        }
+        "left" {
+            set dir_webkit "100% 0%,0% 0%"
+        }
+    }
+    
+    
+    debug "Generating help in file $help_file"
+    
+    
+    set chin [ open $help_file w ]
+    puts $chin "<html>"
+    puts $chin "<body>"
+    puts $chin "<head>"
+    puts $chin "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />"
+    puts $chin "<style>"
+    
+    
+    
+    puts $chin  "html \{ min-height:100%; \} /* to get the gradient to stetch to the bottom of the view port */"
+    puts $chin "body \{"
+    puts $chin "	background: $col1;"
+    puts $chin "	background: -moz-linear-gradient($dir, $col0 0%, $col1 100%), url(img.png) no-repeat 50% 300px;"
+    puts $chin "	background: -webkit-gradient(linear, $dir_webkit, from($col0), to($col1)), url(img.png) no-repeat 50% 300px;"
+    puts $chin "	background: -webkit-linear-gradient($dir, $col0 0%,$col1 100%), url(img.png) no-repeat 50% 300px;"
+    puts $chin "	background: -o-linear-gradient($dir, $col0 0%,$col1 100%), url(img.png) no-repeat 50% 300px;"
+    puts $chin "	background: -ms-linear-gradient($dir, $col0 0%,$col1 100%), url(img.png) no-repeat 50% 300px;"
+    puts $chin "	background: linear-gradient($dir, $col0 0%,$col1 100%), url(img.png) no-repeat 50% 300px;"
+   
+    puts $chin "        margin-top:100px;"
+    puts $chin "        margin-bottom:100px;"
+    puts $chin "        margin-right:50px;"
+    puts $chin "        margin-left:50px;"
+    #puts $chin "        font-family:\"Verdana\";"
+    
+    
+    puts $chin "\}"
+    
+    puts $chin "h1 \{background-color:$colA;color:white;\}"
+    puts $chin "h2 \{background-color:$colB;color:white;\}"
+    
+  
+    puts $chin "p \{"
+    puts $chin "padding-left:50px;"
+    puts $chin "\}"
+    
+    puts $chin "div.stage1 \{padding-left:40px;\}"
+    puts $chin "div.stage2 \{padding-left:30px;\}"
+    puts $chin "div.stage3 \{padding-left:20px;\}"
+    puts $chin "div.stage4 \{padding-left:10px;\}"
+    puts $chin "div.stage5 \{padding-left:10px;\}"
+    puts $chin "div.stage6 \{padding-left:10px;\}"
+    puts $chin "div.stage7 \{padding-left:10px;\}"
+    puts $chin "div.stage8 \{padding-left:10px;\}"
+    
+   
+    
+    
+    puts $chin "div.multiple"
+    puts $chin "\{"
+    puts $chin "padding:10px;"
+    puts $chin "border:5px solid $colA;"
+    puts $chin "margin:0px;"
+    puts $chin "\}"
+    puts $chin "div.xor"
+    puts $chin "\{"
+    puts $chin "padding:10px;"
+    puts $chin "border:5px solid $colB;"
+    puts $chin "margin:0px;"
+    puts $chin "\}"
+
+    puts $chin "div.inxor"
+    puts $chin "\{"
+    puts $chin "padding:20px;"
+    puts $chin "background:white;"
+    puts $chin "border:1px solid $colB;"
+    puts $chin "margin:0px;"
+    puts $chin "\}"
+
+    puts $chin "div.choice"
+    puts $chin "\{"
+    puts $chin "padding:10px;"
+    puts $chin "border:1px solid $colA;"
+    puts $chin "margin:0px;"
+    puts $chin "\}"
+    
+    
+    puts $chin "div.model"
+    puts $chin "\{"
+    puts $chin "background:white;"
+    puts $chin "border:1px solid $col1;"
+    puts $chin "padding:10px;"
+    puts $chin "border:Opx ;"
+    puts $chin "margin:0px;"
+    puts $chin "\}"
+    
+    
+    puts $chin "</style>"
+    puts $chin "</head>"
+    
+    # remplissage du fichier d'aide
+   
+    
+    
+    foreach solv [dTree_getChildren $XMLtree "root"] {
+        if {$solv == "DATA"} {
+            continue
+        }
+        
+        iterative_help root $solv solver $chin $help_dir 0 "root"
+        
+    }
+    
+   
+    
+    # fermeture du fichioer d'aide
+    puts $chin "</html>"
+    puts $chin "</body>"
+    
+    close $chin
+}
+
+proc iterative_help {path name part_class help_channel help_dir stage parent_class} {
+    global  XMLtree help_level
+    set address "$path.$name"
+     set full_address_XML [split $address "."]
+    
+    incr stage
+    
+    puts $help_channel "<div class=\"stage$stage\">"
+    
+    set decorator ""
+    set header ""
+    
+    if {$help_level >= 3} {
+        set header "($part_class:$name)"
+    }
+    
+    set title ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "title"]} {
+        set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    }
+    set default ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "default"]} {
+        set default [dTree_getAttribute $XMLtree $full_address_XML "default"]
+    }    
+    set type ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "type"]} {
+        set type [dTree_getAttribute $XMLtree $full_address_XML "type"]
+    }    
+    set require ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "require"]} {
+        set require [dTree_getAttribute $XMLtree $full_address_XML "require"]
+    }    
+    set existif ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "existif"]} {
+        set existif [dTree_getAttribute $XMLtree $full_address_XML "existif"]
+    }
+    set visibility ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "visibility"]} {
+        set visibility [dTree_getAttribute $XMLtree $full_address_XML "visibility"]
+    }
+    set script ""
+    if {[dTree_attrExists $XMLtree $full_address_XML "script"]} {
+        set script [dTree_getAttribute $XMLtree $full_address_XML "script"]
+    }   
+    
+     
+    switch $part_class {
+        "solver" {
+            
+            solverframe_docu $address $help_channel $help_dir
+            
+         }
+        "tab" {
+            tabs_docu $address $help_channel $help_dir
+            set header "$header [container_docu $address  $help_dir]"
+            
+        } 
+        "model" {
+            set decorator "model"
+            if {$parent_class=="xor"} {
+                set decorator "inxor"
+            }
+            if {$title !=""} {
+                set header "$header <b> $title </b> <br>"
+            }
+            if {$help_level >= 3} {
+                if {$existif !=""} {
+                    set header "$header <font color=red> !!! This model is existing only if the following condition is verified : $existif !!! </font> <br>"
+                }
+            }
+            
+            set header "$header [container_docu $address  $help_dir]"
+            
+        }
+        "multiple" {
+            set decorator "multiple"
+             if {$title !=""} {
+                set header "$header <b> $title </b><br>"
+            }
+           
+            set header "$header MULTIPLE. Each item is composed as : "
+            
+            if {$help_level >= 3} {
+                if {$require!= ""} {
+                    set header "$header \n This multiple is depending on the value of element <b> $require </b>."
+                } else {
+                    set header "$header \nThis multiple is standalone : the user can add/delete items." 
+                }
+            }
+        }
+        "container" {}
+        "action" -
+        "info" -
+        "choice" -
+        "option" -
+        "param" {
+            if {$help_level >= 2} {
+                set header "$header <li>"
+                
+                
+                if {$title !=""} {
+                    set header "$header <b>  $title .</b> "
+                } else {
+                    set header "$header <b>  $name </b> "
+                }
+                
+                if {$part_class == "choice"} {
+                    set header "$header <b> choice among : </b> <br>"
+                    set decorator "choice"
+                }
+                
+                
+                if {$part_class == "info"} {
+                    set header "$header information "
+                    set decorator "choice"
+                }
+                
+                
+                if {$type !=""} {
+                    switch -glob $type {
+                        "integer*" {
+                            set header "$header Integer value."
+                        }
+                        "list_integer*" {
+                            set header "$header List of integers."
+                        }
+                        "double*" {
+                            set header "$header Real value."
+                        }
+                        "list_double*" {
+                            set header "$header List of values."
+                        }
+                        "fraction*" {
+                            set header "$header Real value between 0 and 1."
+                        }
+                        "list_fraction*" {
+                            set header "$header Real value between 0 and 1."
+                        }
+                        "complex*" {
+                            set header "$header Complex value."
+                        }
+                        "string*" {
+                            set header "$header string of characters."
+                        }
+                        "file*" {
+                            set header "$header File."
+                        }
+                        "avbpfile*" {
+                            set header "$header AVBP HDF5 mesh file (mymesh.mesh.h5)."
+                        }
+                        "folder*" {
+                            set header "$header Folder."
+                        }
+                        "default" {
+                            set header "$header $type."   
+                        }
+                    }
+                    
+                }
+                
+                if {$default !=""} {
+                    set header "$header default: $default. <br>"
+                }
+                if {$help_level >= 3} {
+                    set header "$header type: $type. <br>"
+                    
+                    if {$visibility =="hidden"} {
+                        set header "$header (hidden)<br>"
+                    }
+                    if {$script !=""} {
+                        set header "$header for script <b>$script</b>.<br>"
+                    }
+                }
+                set header "$header </li>"
+            
+            }
+           
+        }
+        "xor" {
+            set decorator "xor"
+            if {$title !=""} {
+                set header "$header <b> Exclusive Selection $title</b> <br>"
+            }
+            set header "XOR - Exclusive choice among :"
+            
+            if {$help_level >= 3} {    
+                if {$default !=""} {
+                    set header "$header The Default  value for this exclusive selection Default is $default <br>"
+                }
+            }
+        }
+        default {
+            puts $help_channel "<p> $part_class $name</p>"
+        }
+    }
+   
+   
+   
+    set full_address_XML [split $address "." ]
+    
+    ######## Sort the children according to their "order" attribute
+    set unsorted_children [dTree_getChildren $XMLtree $full_address_XML]
+    set sortedChildren ""
+    set childrenAndOrder ""
+    # First, get children and associated orders
+    foreach child $unsorted_children {
+        set order "0"
+        set childAndOrder ""
+        # Retrieve order from attributes of the child
+        catch {set order [dTree_getAttribute $XMLtree "$full_address_XML $child" order]}
+        lappend childAndOrder $order
+        lappend childAndOrder $child
+        lappend childrenAndOrder $childAndOrder
+    }
+    # Then, sort
+    set childrenAndOrder [lsort -index 0 -integer $childrenAndOrder]
+    # Finally, store them
+    foreach child $childrenAndOrder {
+        lappend sortedChildren [lindex $child 1]
+    }
+    
+   
+   
+    if { $part_class != "multiple" } {   
+        set full_address_XML [split $address "."]
+        if {$decorator != ""} {
+            puts $help_channel "<div class=\"$decorator\">"    
+            }
+        if {$header != ""} {
+            puts $help_channel " $header <br>"    
+        }
+        foreach child $sortedChildren {
+            # Case of ";" type nodes (options)
+            if {[string match "*;*" $child]} {
+                set XML_node_address_child "$full_address_XML \{$child\}"
+            } else {
+                set XML_node_address_child [concat $full_address_XML $child]
+            }
+            if {[catch {set widget_child_class "[dTree_getAttribute $XMLtree $XML_node_address_child nodeType]"}]} {
+                warning "WARNING : $XML_node_address_child doesn't have a node type ...\n Setting it to container ..."
+                set widget_child_class "container"
+            }
+            
+            iterative_help $address $child  $widget_child_class $help_channel $help_dir $stage $part_class
+        }
+        if {$decorator != ""} {
+            puts $help_channel "</div><br>"
+        }
+        
+    } else {
+        set widget_child_class "container"
+        if {$decorator != ""} {
+            puts $help_channel "<div class=\"$decorator\">"    
+        }
+        if {$header != ""} {
+            puts $help_channel " $header  <br>"    
+        }
+        iterative_help $address item  $widget_child_class $help_channel $help_dir $stage parent_class
+        if {$decorator != ""} {
+            puts $help_channel "</div><br>"
+        }
+    }
+    
+    puts $help_channel "</div>"
+}
+
+
+
+
+
+
+#####################
+# HELP Creation
+#####################
+
+proc CreateHelpText { win address} {
+    global ContainerHelpInfo
+    
+    destroy $win.text
+    destroy $win.sbary
+    
+    text $win.text  -foreground [ThemeColor 0.]  -background [ThemeColor 1.1] -highlightthickness 0 -yscrollcommand [list $win.sbary set]
+    
+    ttk::scrollbar $win.sbary -orient vertical -command [list $win.text yview]
+    
+     
+    
+    $win.text insert end "\n    $ContainerHelpInfo($address-title) \n" "Title"
+    ShowHelpElement $win.text $ContainerHelpInfo($address-docu) $address help_text    
+    
+    $win.text configure -wrap word
+    $win.text tag configure "Body" -font "helvetica 12 " -lmargin1 40 -lmargin2 30 -rmargin 30 -foreground [ThemeColor 0.50]
+    $win.text tag configure "Title" -font "helvetica 16 bold" -justify center -foreground [ThemeColor 0.80]
+    $win.text tag configure "Section" -font "helvetica 12 bold"  -lmargin1 40 -lmargin2 30 -rmargin 30  -foreground [ThemeColor 0.65]
+    
+    $win.text tag configure "Float" -font "helvetica 12 bold" -justify center -foreground [ThemeColor 0.50]
+    
+    $win.text tag configure "Item" -font "helvetica 12 " -lmargin1 70 -lmargin2 30 -rmargin 30 -foreground [ThemeColor 0.50]
+    
+    $win.text configure -state disabled
+    
+    place  $win.text -relx 0.1 -rely 0.1 -relwidth 0.8 -relheight 0.8
+    place  $win.sbary -relx 0.9 -rely 0.1  -relheight 0.8 -anchor ne
+   
+    return $win.text
+}
+
+
+# a parser to present the help with pictures 
+proc ShowHelpElement { win helptext address textOrlabel {help_dir dummy}} {
+    global  widgetInfo pathEngine solverPath
+    
+    set html_help ""
+    
+    set fileroot [file join $solverPath "XML"]
+    foreach item [lrange [split $address "."] 1 end-1] {
+        set fileroot [file join $fileroot $item]
+    }
+    
+   
+    # Searching for corresponding directory
+    while {![file exists $fileroot] && $fileroot != [file dirname $fileroot]} {
+        set fileroot [file dirname $fileroot]
+        
+    }
+    
+    set index 0    
+    set newline ""
+    set bit ""
+
+    # Convert html codes into plain text (e.g. "&gt;" => ">")
+    set helptext [string map -nocase {
+    "&lt;"      "<"
+    "&gt;"      ">"
+    "&le;"      "<="
+    "&ge;"      ">="
+    "&eacute"   "Ã©"
+    } $helptext]
+
+    
+    foreach char [split $helptext ""] {
+        switch $char {
+            "[" {
+                # print last arm of text
+                
+                set newline [string trim $newline$bit]
+                
+                
+                if {$newline != ""} {
+                    switch $textOrlabel {
+                        help_text {
+                            $win insert end "$newline \n" "Body"
+                        }
+                        desc_label {
+                            incr index
+                            ttk::label $win.item$index -text $newline -wraplength $widgetInfo(guiSmallWidgetWidth) -foreground [ThemeColor 0.20]
+                            pack $win.item$index -side top
+                        }
+                        help_html {
+                            set html_help "$html_help <p> $newline </p> <br>"
+                        }
+                    }
+                }
+                # clean the buffer
+                set bit ""
+                set newline ""
+            }
+            
+            "]" {
+                # special items
+                set newline "$newline$bit"
+                foreach item [split $newline ";"] {
+                    set key [lindex [split $item "="] 0 ]
+                    set value [string trim [lindex [split $item "="] 1]]
+                    switch $key {
+                        "logo" {
+                            switch $textOrlabel {
+                                help_text {
+                                    $win insert end " " "Float"
+                                    $win image create end -image icon_$value 
+                                    $win insert end "\n"
+                                }
+                                desc_label {
+                                    incr index
+                                    ttk::label $win.item$index -image icon_$value
+                                    pack $win.item$index -side top
+                                }
+                                help_html {
+                                    set html_image "[join [split $address "."] "_"]_$value"
+                                    file copy -force [file join $pathEngine IMAGES logo_$value.gif]  [file join $help_dir $html_image]
+                                    set html_help "$html_help <div id=\"wrapper\" style=\"width:100%; text-align:center\">"
+                                    set html_help "$html_help <img src=\"$html_image\"; style=\"margin:auto;\">"
+                                    set html_help "$html_help </div> <br>"
+                                    
+                                }
+                            }
+                        }
+                        "image" {
+                            if {[file exists [file join $fileroot $value]] == 0} {
+                                log "Error : file [file join $fileroot $value] doesn't exist, skipping ..."
+                            } else {
+                                image create photo $value -file [file join $fileroot $value]
+                                switch $textOrlabel {
+                                    help_text {
+                                        $win insert end " " "Float"
+                                        $win image create end -image $value 
+                                        $win insert end "\n"
+                                    }
+                                    desc_label {
+                                        incr index
+                                        ttk::label $win.item$index -image $value 
+                                        pack $win.item$index -side top
+                                    }
+                                    help_html {
+                                        set html_image "[join [split $address "."] "_"]_$value"
+                                        file copy -force [file join $fileroot $value]  [file join $help_dir $html_image]
+                                        set html_help "$html_help <div id=\"wrapper\" style=\"width:100%; text-align:center\">"
+                                        set html_help "$html_help <img src=\"$html_image\"; style=\"margin:auto;\">"
+                                        set html_help "$html_help </div> <br>"
+                                        
+                                    }
+                                }
+                            }
+                        }
+                        "caption" {
+                            switch $textOrlabel {
+                                help_text {
+                                    $win insert end "$value \n" "Float"
+                                }
+                                desc_label {
+                                    incr index
+                                    ttk::label $win.item$index -text $value -foreground [ThemeColor 0.20] -wraplength $widgetInfo(guiSmallWidgetWidth)
+                                    pack $win.item$index -side top
+                                }
+                                help_html {
+                                    set html_help "$html_help <div id=\"wrapper\" style=\"width:100%; text-align:center\">"
+                                    set html_help "$html_help <p> $value </p>"
+                                    set html_help "$html_help </div> <br>"
+                                }
+                            }
+                        }
+                        "section" {
+                            switch $textOrlabel {
+                                help_text {
+                                    $win insert end "\n" "Body"
+                                    $win insert end "$value \n" "Section"
+                                }
+                                desc_label {
+                                    incr index
+                                    ttk::separator $win.item$index -orient horizontal
+                                    pack $win.item$index -side top -fill both -pady {3 0}
+                                    incr index
+                                    ttk::label $win.item$index -text $value -foreground [ThemeColor 0.40] -wraplength $widgetInfo(guiSmallWidgetWidth) 
+                                    pack $win.item$index -side top -anchor w
+                                }
+                                help_html {
+                                    set html_help "$html_help <br> <p> $value </p> <hr> <br>"
+                                }
+                            }
+                        }
+                        "item" {
+                            switch $textOrlabel {
+                                help_text {
+                                    $win insert end "- $value\n" "Item"
+                                }
+                                desc_label {
+                                    incr index
+                                    ttk::label $win.item$index -text "- $value" -foreground [ThemeColor 0.20] -wraplength $widgetInfo(guiSmallWidgetWidth) 
+                                    pack $win.item$index -side top -anchor w -padx {10 0}
+                                }
+                                help_html {
+                                    set html_help "$html_help  &#8226; $value  <br>"
+                                }
+                                
+                            }
+                        }
+                        "subitem" {
+                            switch $textOrlabel {
+                                help_text {
+                                    $win insert end "              - $value\n" "Item"
+                                }
+                                desc_label {
+                                    incr index
+                                    ttk::label $win.item$index -text "- $value" -foreground [ThemeColor 0.20] -wraplength $widgetInfo(guiSmallWidgetWidth) 
+                                    pack $win.item$index -side top -anchor w -padx {20 0}
+                                }
+                                help_html {
+                                    set html_help "$html_help  &#160 &#160 &#8211; $value  <br>"
+                                }
+                                
+                            }
+                        }
+                    }
+                }
+                
+                set bit ""
+                set newline ""
+            }
+            default {
+                # capture des accents pour corrections
+                #puts $char
+                #if {$char == "Â"} { puts "jj $char" }  # do  not work
+                #if {$textOrlabel == "help_html"} {
+                #    switch $char {
+                #        "Â" {
+                #            debug " switching Â"
+                #            set char "&eacute;"
+                #        }
+                #        default {
+                #            
+                #        }
+                #    }
+                #}
+                set bit "$bit$char"
+            }
+        }
+    }
+    # last arm of text
+    set newline "$newline$bit"
+    switch $textOrlabel {
+        help_text {
+            $win insert end "$newline \n" "Body"
+        }
+        desc_label {
+            incr index
+            ttk::label $win.item$index -text $newline -wraplength $widgetInfo(guiSmallWidgetWidth) -foreground [ThemeColor 0.20]
+            pack $win.item$index -side top 
+        }
+        help_html {
+            set html_help "$html_help <p> $newline </p>"
+        }
+    }
+    
+    return $html_help
+
+}
+
+
+# documentation
+
+proc container_docu {address  help_dir} {
+
+    global widgetInfo XMLtree modelPath  help_level
+    set full_address_XML [split $address "."]
+    
+    #set fileroot "[file join $modelPath]"
+    #foreach item [lrange [split $address "."] 1 end] {
+    #    set fileroot [file join $fileroot $item]
+    #}
+    #set logofile [dTree_getAttribute $XMLtree $full_address_XML "image"]
+    #set path_logofile [file join $fileroot $logofile]
+    #set html_image "[join $full_address_XML "_"]_$logofile"
+    #file copy -force $path_logofile  [file join $help_dir $html_image]
+    #debug [file join $help_dir $html_image]
+    #puts $chin "<img src=\"$html_image\">"
+
+    set header ""
+    
+    if {$help_level >= 1} {
+        if {![catch {set desc [dTree_getAttribute $XMLtree "$full_address_XML" "desc"]}]} {   
+           #puts $chin "<h5> Description </h5>"
+           set header "$header [ShowHelpElement dummy $desc $address help_html $help_dir]"
+       }
+       if {![catch {set docu [dTree_getAttribute $XMLtree "$full_address_XML" "docu"]}]} {   
+           #puts $chin "<h5> Documentation </h5>"
+           set header "$header [ShowHelpElement dummy $docu $address help_html $help_dir]"
+       }
+    }
+    
+    return $header
+}
+
+
+proc help_add_desc_docu_to_widget {  } {
+    uplevel 1 {} {
+        
+        global ContainerHelpInfo widgetInfo
+        
+        
+        set windoc $docu_prefered_place
+        set ContainerHelpInfo($address-title) [dTree_getAttribute $XMLtree $full_address_XML_clean "title"]
+        #add desc if needed
+        if {![catch {set desc [dTree_getAttribute $XMLtree "$full_address_XML" "desc"]}]} {   
+            ttk::frame $windoc.desc
+            pack $windoc.desc -side $docu_prefered_side -anchor w -fill x
+            ShowHelpElement $windoc.desc $desc $address desc_label
+    
+        }
+        
+        #add help if needed
+        if {![catch {set docu [dTree_getAttribute $XMLtree "$full_address_XML" "docu"]}]} {
+            set ContainerHelpInfo($address-docu) $docu
+            #add help
+            ttk::label $windoc.help -text "Learn more..." -image icon_info -compound right 
+        #    place $win.help -anchor se -relx 1 -rely 1 -width 20 -height 20 
+            pack $windoc.help -anchor se -side $docu_prefered_side 
+        
+            bind $windoc.help <ButtonPress> [subst {
+                set win \[ CreateSplashScreen \]
+                CreateHelpText \$win $address
+            }]
+        } else {    
+            set ContainerHelpInfo($address-docu) ""
+        }
+       
+       
+       # add the unpackme method for help and desc if needed
+       set widgetInfo(unpackme-$windoc.desc) [subst {
+            pack forget $windoc.desc
+       }]
+       set widgetInfo(unpackme-$windoc.help) [subst {
+            pack forget $windoc.help
+       }]
+       
+        
+    }
+}
+
+
+
+
+
+
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_theme.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_theme.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/functions_theme.tcl	(revision 4775)
@@ -0,0 +1,110 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+#################################################
+# Procedure to swithch from theme to theme
+# still need a fix on the smartpaker
+#################################################
+
+proc ThemeUpdate { theme } {
+    set themelist [ttk::style theme names]
+    
+    if {[lsearch $themelist $theme] ==-1} {
+	popup_error "Theme $theme not available on this platform\n switching to default theme clam" exitcontinue
+	ttk::style theme use clam
+    } else {
+	   # log "GUI theme : $theme" 
+	ttk::style theme use $theme
+    }
+    
+    
+    # label des modeles
+    ttk::style configure Model.TLabelframe.Label -foreground [ThemeColor 0.30]
+    # labels multiples et xor
+    ttk::style configure Xor.TLabelframe.Label -foreground [ThemeColor 0.30]    
+    ttk::style configure Multiple.TLabel -foreground [ThemeColor 0.50]
+  
+    ttk::style configure Disabled.TLabel -foreground [ThemeColor 0.50]
+    #ttk::style configure Flat.TLabelframe -relief flat -text ""
+    
+    # disparition des Tabs sur les notebooks
+    ttk::style layout NoTabs.TNotebook.Tab null
+    ttk::style layout NoTabs.TNotebook null
+    
+    event generate . <<ThemeUpdate>> 
+}
+
+
+#################################################
+# Procedure to get the main theme color
+# and redurn any shade of the same color
+#
+# 1.0 is the initial bg color
+# factor below 1 gives a darker color
+# factor beyond 1 gives a lighter color
+#################################################
+proc ThemeColor { factor {item background}  } {
+    if {[getConfig "config gui appearance theme" ]== "aqua"} {
+	set rgb "60909 60909 60909"
+    } else {
+        set rgb [winfo rgb . [ttk::style lookup .activefield -$item]]
+    }
+    
+    set R [expr {round(min(255,[lindex $rgb 0]*1.*$factor/257.))}]
+    set G [expr {round(min(255,[lindex $rgb 1]*1.*$factor/257.))}]
+    set B [expr {round(min(255,[lindex $rgb 2]*1.*$factor/257.))}]
+
+    set newrgb [format #%02x%02x%02x $R $G $B ]
+
+    return $newrgb
+    
+    
+}
+
+
+proc getcharsize { sizeinpx {fontname courier} } {
+    set width0 [font measure $fontname "0"]
+    set charsize [expr {int(1.0*$sizeinpx/$width0)}]
+    return $charsize
+}
+
+proc getcharheight { sizeinpx {fontname courier} } {
+    set height [font metrics  $fontname -linespace] 
+    set charheight [expr {int(1.0*$sizeinpx/$height)}]
+    return $charheight
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/genPyFromXMLtree.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/genPyFromXMLtree.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/genPyFromXMLtree.tcl	(revision 4775)
@@ -0,0 +1,187 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc genPyFromXMLtree {} {
+    global XMLtree loadApplication
+    
+    if {[catch {
+       genPyOutput "from XDR import *\n"
+       genPyOutput "###########################"
+       genPyOutput "# INITIALIZATION\n"
+       genPyOutput "init()\n"
+        
+       genPyFromNode "root $loadApplication" "" "0 0" ""
+        
+       genPyOutput "\n\n#########################\n# FINISHING"
+       genPyOutput "finish()"
+    } err err2]} { 
+        genPyOutput "[lindex $err2 7]"
+    }
+}
+
+proc genPyOutput {txt} {
+    puts $txt
+} 
+
+proc genPyConstructPattern {node scheme multiples} {
+    global XMLtree
+    
+    set l [llength $scheme]    
+    # Activating one part at a time on the address descriptor until descriptor is unique
+    for {set i 1} {$i < $l} {incr i} {
+        
+        # Pattern construction
+        set pattern ""
+        for {set j 0} {$j < $l} {incr j} {
+            if {[lindex $scheme $j] == 1} {
+                lappend pattern [lindex $node $j]
+            }
+        }
+        set pattern [join $pattern " "]
+        
+        if {[llength [dTree_searchNode $XMLtree $pattern]] == 1} {
+            break
+        }
+        set nextId [expr {$l-$i-1}]
+        if {[lsearch $multiples $nextId] > -1} {
+            lset scheme $nextId 0
+        } else {
+            lset scheme $nextId 1
+        }
+    }
+    set pythonArgs ""    
+    foreach elt [split $pattern " "] {
+        # If multiple , qqch !
+        set pythonArgs [lreplace $pythonArgs 0 -1 "\"$elt\""]
+    }
+    
+    foreach mul $multiples {
+        lappend pythonArgs "multiple${mul}"
+    }
+    return $pythonArgs
+}
+
+proc genPyFromNode {node indent mandatory multiples} {
+    global XMLtree 
+    
+    set newIndent ""
+    set childNotDone 1
+    
+    #set attrs [dTree_getAttributes $XMLtree $node]
+    if {[catch {set type [dTree_getAttribute $XMLtree $node "nodeType"]} err]} {
+        log $err
+        set type "undefined" 
+    }
+    
+    set name [lindex $node end]
+    
+    
+    
+    # Dealing with existifs
+    if {[dTree_attrExists $XMLtree $node "existif"]} {
+        set scheme $mandatory
+        lset scheme end 1        
+        set pythonArgs [genPyConstructPattern $node $scheme $multiples]        
+        genPyOutput "${indent}if nodeExists([join $pythonArgs {,}]):"
+        genPyOutput "${indent}   pass"
+        set indent "${indent}   "
+    }
+    
+    #genPyOutput "${indent}[lindex $node end] is a $type"
+    
+    switch $type {
+        tab {
+            genPyOutput "\n\n${indent}###########################"
+            genPyOutput "${indent}# Tab : $name "
+            genPyOutput "${indent}##################\n"            
+        }
+        
+        model {
+            genPyOutput "${indent}# Model : $name"
+        }
+        
+        
+        choice -
+        param {
+            # Construct list of params
+            set scheme $mandatory
+            lset scheme end 1
+#            genPyOutput "---------  $node"
+#            genPyOutput "---------  $scheme"
+            set pythonArgs [genPyConstructPattern $node $scheme $multiples]                        
+                        
+            genPyOutput "${indent}print getValue([join $pythonArgs {,}])"
+        }
+        
+        xor {
+            set childNotDone 0
+            set scheme $mandatory
+            lset scheme end 1            
+            set pythonArgs [genPyConstructPattern $node $scheme $multiples]            
+            foreach child [dTree_getChildren $XMLtree $node] {
+                genPyOutput "${indent}if getValue([join $pythonArgs {,}]) == \"$child\" :\n${indent}   pass"
+                genPyFromNode "$node $child" "${indent}   " "$mandatory 0" "$multiples"
+            }            
+        }
+        
+        multiple {
+            set scheme $mandatory
+            lset scheme end 1            
+            set pythonArgs [genPyConstructPattern $node $scheme $multiples]
+            genPyOutput "${indent}for multiple[llength $node] in getChildrenName([join $pythonArgs {,}]):"            
+            set newIndent "   "
+            lappend multiples [llength $node]
+
+        }
+        
+        item {
+            # Do nothing
+        }
+        action -
+        solver -
+        option -
+        info {
+            # Do nothing 
+        }
+        
+        
+    }
+    if {$childNotDone} {
+        foreach child [dTree_getChildren $XMLtree $node] {
+            genPyFromNode "$node $child" "${indent}$newIndent" "$mandatory 0" "$multiples"
+        }
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/grapher_utilities.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/grapher_utilities.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/grapher_utilities.tcl	(revision 4775)
@@ -0,0 +1,803 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+proc grapher_highlight_node {wincan anchor match side index} {
+    set a_x [lindex $anchor 0]
+    set a_y [lindex $anchor 1]
+    
+    switch $match {
+        "value" {
+            set color red
+        }
+        "children" {
+            set color green4
+        }
+        
+    }
+    set h 5
+    $wincan create oval [expr {$a_x-$h}] [expr {$a_y-$h}] [expr {$a_x+$h}] [expr {$a_y+$h}] -outline $color -width 2 -tags "graph $side"
+    set h 10
+    canvas_text_vector $wincan [expr {$a_x+$h}] [expr {$a_y+$h}] $index nw 10 0 $color "graph $side"
+}
+
+
+proc grapher_drawnode {wincan anchor  maxdepth childnb kinnb dsname dsaddress side value shade {title "notitle"}  } {
+    
+    set color "yellow"
+    if {[string is double $value]} {set color "orange"}
+    if {[string is integer $value]} {set color "red"}
+    if {[llength $value] >1} {set color "blue"}
+    if {$value==""} {set color "white"}
+ 
+    set color [shadeColor $color $shade]
+    set shadeblack [shadeColor "black" $shade]
+    
+    set dist [expr {10+pow($maxdepth,1.8)* 2+pow($childnb,0.7)* 2+pow($kinnb,2)* 0.1}]
+    set a_x [lindex $anchor 0]
+    set a_y [lindex $anchor 1]
+    set a_angle [lindex $anchor 2]
+    #puts "$a_x+$dist*cos($a_angle*3.1416/180.0)"
+    set b_x [expr {$a_x+$dist*cos(($a_angle-90)*3.1416/180.0)}]
+    set b_y [expr {$a_y+$dist*sin(($a_angle-90)*3.1416/180.0)}]
+    
+    set tag "$dsname#$dsaddress"
+    $wincan create line $a_x $a_y $b_x $b_y -fill $shadeblack -tags "graph $side" 
+    
+    set h 4
+    #$wincan create oval [expr {$b_x-$h}] [expr {$b_y-$h}] [expr {$b_x+$h}] [expr {$b_y+$h}] -fill $shadeblack  -width 0 -tag  "$tag handle graph $side"
+    set h 3
+    $wincan create oval [expr {$b_x-$h}] [expr {$b_y-$h}] [expr {$b_x+$h}] [expr {$b_y+$h}] -fill $color -width 0 -tag  "$tag handle graph $side"
+    
+    set lastnode [lindex [split $dsaddress "."] end]
+    
+    set msg [string map { "[" "(" "]" ")" } "$title\n $value" ] 
+    $wincan bind $tag <Enter> [subst {grapher_showlocation $wincan  "$msg" }]
+    $wincan bind $tag <Leave> [subst {$wincan delete "pointer"}]
+    set new_anchor "$b_x $b_y $a_angle"
+    return $new_anchor
+}
+
+proc grapher_children_directions {dsname a_angle dsaddress} {
+    upvar $dsname dataset
+    set children $dataset($dsaddress-children)
+    set list_angle_child ""
+    
+    if {$a_angle > 0 && $a_angle < 180} {
+        set shift 5
+    } elseif {$a_angle < 0} {
+        set shift -5
+    } else {
+        set shift 0
+    }
+    
+    if {$children != ""} {
+        set nchild [llength $children]
+        
+        switch $nchild {
+            "1" {
+                set list_angle_child 0 
+            }
+            "2" {
+                set list_angle_child {-30 +30}    
+            }
+            "3" {
+                set list_angle_child {-45 0 45}
+            }
+            "4" {
+                set list_angle_child {-60 -20 20 60}
+            }
+            "5" {
+                set list_angle_child {-90 -45 0 45 90}
+            }
+            "6" {
+                set list_angle_child {-125 -75 -25 25 75 125}
+            }
+            default {
+                set list_angle_child ""
+                for {set i 0} {$i < $nchild} {incr i} {
+                     set angle [expr { -125 + (($i)*1.0/($nchild-1))*2.0*125    }]
+                    lappend list_angle_child $angle
+                }
+            }
+        }
+        set final_list ""
+            for {set i 0} {$i < $nchild} {incr i} {
+            lappend final_list [expr {$shift + [lindex $list_angle_child $i]}]
+        }
+        set list_angle_child $final_list
+    }
+    
+    
+    return $list_angle_child
+}
+
+proc grapher_trace { address dsname  anchor dsaddress side} {
+    
+    upvar $dsname dataset
+    
+    global widgetInfo
+    
+    set wincan $widgetInfo($address-wincan) 
+    
+    set title ""
+    if {$dsaddress != "dataset"} {
+        set title  [grapher_gettitle_of_child dataset "$dsaddress" ] 
+    }
+    
+    
+    # draw node
+    set new_anchor [grapher_drawnode $wincan $anchor $dataset($dsaddress-maxdepth) $dataset($dsaddress-childnb) $dataset($dsaddress-kinnb) $dsname $dsaddress $side $dataset($dsaddress-value) 0.0 $title]
+    
+    # call iteration for children children
+    set children $dataset($dsaddress-children)
+    
+    set b_x [lindex $new_anchor 0]
+    set b_y [lindex $new_anchor 1]
+    set a_angle [lindex $new_anchor 2]
+    set list_angle_child [grapher_children_directions dataset $a_angle $dsaddress]
+    set child_id 0
+    
+    
+   
+    #foreach child  $children 
+    foreach child [grapher_ordered_children dataset $dsaddress all] {
+        set anglechild [expr {$a_angle+[lindex $list_angle_child $child_id]}]
+        grapher_trace $address dataset "$b_x $b_y $anglechild" "$dsaddress.$child" $side
+        incr child_id
+    }
+    
+}
+
+proc grapher_ordered_children {dsname dsaddress subset} {
+    upvar $dsname dataset
+    set children $dataset($dsaddress-children)
+    if {$subset == "all"} {
+        set subset $children
+    }
+    
+    set list_item_childnb ""
+    foreach child  $dataset($dsaddress-children) {
+        if {[lsearch $subset $child ]!= -1} {
+            lappend list_item_childnb [list $child $dataset($dsaddress.$child-childnb)]
+        }
+    }
+    set ordered_list_item_childnb [lsort -integer -decreasing -index 1 $list_item_childnb]
+    
+    set list_pyramid ""
+    set side "left"
+    foreach pair $ordered_list_item_childnb {
+        set child [lindex $pair 0]
+        switch $side {
+            "left" {
+                set list_pyramid [ concat  $child $list_pyramid ]
+                set side "right"
+            }
+            "right" {
+                set list_pyramid [ concat   $list_pyramid $child]
+                set side "left"
+            }
+        }
+    }
+    return  $list_pyramid
+}
+proc grapher_showlocation { wincan msg } {
+    
+    $wincan delete "pointer"
+    set x [$wincan canvasx [expr {[winfo pointerx $wincan ] - [winfo rootx $wincan ]}]]
+    set y [$wincan canvasy [expr {[winfo pointery $wincan ] - [winfo rooty $wincan ]}]]
+    canvas_text_highlighted $wincan $x $y  $msg "pointer" 
+}
+
+proc grapher_fill {address dsname dsaddress indent dump} {
+    global widgetInfo
+    upvar $dsname dataset
+    incr indent 
+    set node [list "$indent" [lindex [split $dsaddress "."] end] "$dataset($dsaddress-value)"]
+    set children $dataset($dsaddress-children)
+    
+    # write array representation
+    ####################################
+    # for graph issues
+    # add the max depth attribute
+    # add the number of children
+    set dataset($dsaddress-maxdepth) 0
+    set dataset($dsaddress-childnb) 0
+    set fatheraddress [join [lrange [split $dsaddress "."] 0 end-1] "."]
+    if {$fatheraddress == ""} {
+        set kin 0
+    } else {
+        set kin $dataset($fatheraddress-childnb)
+    }
+    
+    set dataset($dsaddress-kinnb) $kin
+    
+    if {$children != ""} {
+        set dataset($dsaddress-childnb) [llength $children]
+        set dataset($dsaddress-maxdepth) 1
+        set tmpadr [join [lrange [split $dsaddress "."] 0 end-1] "."]
+        set depth 1
+        while {$tmpadr != ""} {
+            incr depth
+            if {$depth > $dataset($tmpadr-maxdepth)} {
+                set dataset($tmpadr-maxdepth) $depth
+            }
+            set tmpadr [join [lrange [split $tmpadr "."] 0 end-1] "."]
+        }
+    }
+    
+    
+    ####################################
+    
+    # probably shoud add number of children here!
+    
+       
+    foreach child $children {     
+        grapher_fill $address "dataset" "$dsaddress.$child" $indent $dump
+    }
+     
+    return 
+}
+
+
+
+
+
+proc grapher_html_write_table { address msg mode {lvl 100} } {
+    global widgetInfo    
+    set folder $widgetInfo($address-folder) 
+    set filerootname $widgetInfo($address-filerootname) 
+    
+    set promote_begin ""
+    set promote_end ""
+    
+    if {$lvl == 1} {
+        set promote_begin "<h2>"
+        set promote_end "<\h2>"
+    }
+    
+    if {$lvl == 2} {
+        set promote_begin "<h3>"
+        set promote_end "<\h3>"
+    }
+    
+    if {$lvl == 3} {
+        set promote_begin "<h4>"
+        set promote_end "<\h4>"
+    }
+    if {$lvl == 4} {
+        set promote_begin "<h5>"
+        set promote_end "<\h5>"
+    }
+    
+    
+    
+    #add text in html report
+    if {$widgetInfo($address-dump)} {
+        set htmlfile [open "[file join $folder $filerootname].html" a+]
+        switch $mode {
+            "start" {
+                puts $htmlfile "<table border='0'> <caption> $msg </caption>"
+            }
+            "end" {
+                puts $htmlfile "</table>"
+            }
+             "headers" {
+                 puts $htmlfile "    <tr>"
+                 foreach item $msg {
+                    puts $htmlfile "      <th>"
+                    puts $htmlfile "      $item"
+                    puts $htmlfile "      </th>"
+                 }
+                 puts $htmlfile "    </tr>"
+            }
+            
+            "value" {
+                 puts $htmlfile "    <tr>"
+                 foreach item $msg {
+                    puts $htmlfile "      <td>"
+                    
+                    puts $htmlfile "  <span style=\"color:red\">    $promote_begin [limit_string $item 50] $promote_end </span>"
+                    puts $htmlfile "      </td>"
+                 }
+                 puts $htmlfile "    </tr>"
+            }
+            "children" {
+                 puts $htmlfile "    <tr>"
+                 foreach item $msg {
+                    puts $htmlfile "      <td>"
+                    puts $htmlfile "   <span style=\"color:green\">   $promote_begin  [limit_string $item 50] $promote_end </span>"
+                    puts $htmlfile "      </td>"
+                 }
+                 puts $htmlfile "    </tr>"
+            }
+            default {
+                 puts $htmlfile "    <tr>"
+                 foreach item $msg {
+                    puts $htmlfile "      <td>"
+                    puts $htmlfile "    $promote_begin [limit_string $item 50] $promote_end"
+                    puts $htmlfile "      </td>"
+                 }
+                 puts $htmlfile "    </tr>"
+            }
+        }
+        close $htmlfile
+    }
+}
+
+
+
+proc grapher_compare {address dsname1 dsname2 dsaddress anchor1 anchor2 } {
+    upvar $dsname1 dataset1
+    upvar $dsname2 dataset2
+    global widgetInfo
+    
+    grapher_setup_XML dataset1 $dsaddress
+    
+    set wincan $widgetInfo($address-wincan)
+    set wintv   $widgetInfo($address-wintv)
+    set folder $widgetInfo($address-folder) 
+    
+    
+    
+    set value1 $dataset1($dsaddress-value)
+    set value2 $dataset2($dsaddress-value)
+    set children1 $dataset1($dsaddress-children)
+    set children2 $dataset2($dsaddress-children)
+    
+    
+        
+    set shade 0.7
+    set match "match"
+    set v1 $value1
+    set v2 ""
+    
+    if {$value1 != $value2} {
+        set match "value"
+        incr widgetInfo($address-mismatch)
+        set shade 0.0
+        set v1  "($widgetInfo($address-mismatch)) $value1"
+        set v2  "($widgetInfo($address-mismatch)) $value2"
+    }
+    if {$children1 != $children2} {
+        set only1 ""
+        set only2 ""
+        set both ""
+        
+        if {$match != "value"} {
+         incr widgetInfo($address-mismatch)
+        }
+        
+        foreach child $children1 {
+            if {[lsearch  $children2 $child ] ==-1 } {
+                lappend only1 $child
+            } else {
+                lappend both $child
+            }
+        }
+        
+        foreach child $children2 {
+            if {[lsearch  $children1 $child ] ==-1 } {
+                lappend only2 $child
+            } 
+        }
+        
+        if {$only1 != ""} {
+            set v1 "($widgetInfo($address-mismatch)) : [join $only1 ";"]"
+        } else {
+            set v1 ""
+        }
+        if {$only2 != ""} {
+            set v2 "($widgetInfo($address-mismatch)) : [join $only2 ";"]"
+        } else {
+            set v2 ""
+        }
+        set match "children"
+        set shade 0.0
+    }
+    
+    
+        
+    set title ""
+    if {$dsaddress != "dataset"} {
+        set title  [grapher_gettitle_of_child dataset1 "$dsaddress" ] 
+        set lvl [llength [split "$dsaddress" "."] ]
+        grapher_html_write_table $address [list $title $v1 $v2] $match $lvl
+        $wintv insert [crop_address $dsaddress 1] end -id $dsaddress -text "$title" -values [list $v1 $v2] -open $widgetInfo($address-tvopen) -tag $match
+        if {$match != "match"} {
+            $wintv see $dsaddress
+        }
+    }
+    
+    
+    # draw node
+    set new_anchor1 [grapher_drawnode $wincan $anchor1 $dataset1($dsaddress-maxdepth) $dataset1($dsaddress-childnb) $dataset1($dsaddress-kinnb) $dsname1 $dsaddress left $dataset1($dsaddress-value) $shade $title]
+    set new_anchor2 [grapher_drawnode $wincan $anchor2 $dataset2($dsaddress-maxdepth) $dataset2($dsaddress-childnb) $dataset2($dsaddress-kinnb) $dsname2 $dsaddress right $dataset2($dsaddress-value) $shade $title]
+    
+    
+
+    set b1_x [lindex $new_anchor1 0]
+    set b1_y [lindex $new_anchor1 1]
+    set a1_angle [lindex $new_anchor1 2]
+    set list_angle_child1 [grapher_children_directions dataset1 $a1_angle $dsaddress]
+    
+    set b2_x [lindex $new_anchor2 0]
+    set b2_y [lindex $new_anchor2 1]
+    set a2_angle [lindex $new_anchor2 2]
+    set list_angle_child2 [grapher_children_directions dataset2 $a2_angle $dsaddress]
+  
+    switch $match {
+        "match" {
+            set child_id 0
+            foreach child [grapher_ordered_children dataset1 $dsaddress all] {
+                set anglechild [expr {$a1_angle+[lindex $list_angle_child1 $child_id]}]
+                grapher_compare $address dataset1 dataset2 "$dsaddress.$child" "$b1_x $b1_y $anglechild" "$b2_x $b2_y $anglechild"
+                     
+                incr child_id
+            }
+        }
+        "value" {
+            grapher_highlight_node $wincan "$b1_x $b1_y 0" $match left $widgetInfo($address-mismatch)
+            grapher_highlight_node $wincan "$b2_x $b2_y 0" $match right $widgetInfo($address-mismatch)
+            set child_id 0
+            foreach child [grapher_ordered_children dataset1 $dsaddress all] {
+                set anglechild [expr {$a1_angle+[lindex $list_angle_child1 $child_id]}]
+                grapher_trace $address dataset1  "$b1_x $b1_y $anglechild" "$dsaddress.$child" left
+                incr child_id
+            }
+            set child_id 0
+            foreach child [grapher_ordered_children dataset2 $dsaddress all] {
+                set anglechild [expr {$a2_angle+[lindex $list_angle_child2 $child_id]}]
+                grapher_trace $address dataset2  "$b2_x $b2_y $anglechild" "$dsaddress.$child" right
+                incr child_id
+            }
+        }
+        "children" {
+
+            grapher_highlight_node $wincan "$b1_x $b1_y 0" $match left $widgetInfo($address-mismatch)
+            grapher_highlight_node $wincan "$b2_x $b2_y 0" $match right $widgetInfo($address-mismatch)
+            set child_id 0
+            foreach child [grapher_ordered_children dataset1 $dsaddress $both]   {
+                set anglechild [expr {$a1_angle+[lindex $list_angle_child1 $child_id]}]
+                grapher_compare $address dataset1 dataset2 "$dsaddress.$child" "$b1_x $b1_y $anglechild" "$b2_x $b2_y $anglechild" 
+                incr child_id
+            }
+            foreach child [grapher_ordered_children dataset1 $dsaddress $only1]   {
+                set anglechild [expr {$a1_angle+[lindex $list_angle_child1 $child_id]}]
+                grapher_trace $address dataset1  "$b1_x $b1_y $anglechild" "$dsaddress.$child" left
+                incr child_id
+            }
+            
+            set child_id 0
+            foreach child $both {
+                incr child_id
+            }
+            foreach child [grapher_ordered_children dataset2 $dsaddress $only2]  {
+                set anglechild [expr {$a2_angle+[lindex $list_angle_child2 $child_id]}]
+                grapher_trace $address dataset2  "$b2_x $b2_y $anglechild" "$dsaddress.$child" right
+                incr child_id
+            }
+            
+        }
+    }
+    return 
+}
+
+
+
+proc grapher_loadfile {dsname filename} {
+    upvar $dsname dataset
+    
+    set chout [ open $filename r ]
+    set out [ split [ read $chout] "\n" ]
+    close $chout
+
+    foreach line $out {
+        set linesplit [split $line "="]
+        set key [lindex $linesplit 0 ]
+        set value [string trim [join [lrange $linesplit 1 end ] "="]  " " ]
+        set dataset($key) $value   
+    }
+    return 
+}
+
+
+proc grapher_zoom {wincan factor} {
+     set y0 0
+     set x0 0
+     $wincan scale all $x0 $y0 $factor $factor
+     $wincan configure -scrollregion [ $wincan bbox all]
+}
+
+
+    
+proc grapher_bboxgraphs {address } {
+    global widgetInfo
+    
+    set wincan $widgetInfo($address-wincan)
+  
+    set bboxright  [$wincan bbox right]
+    set bboxleft [$wincan bbox left]
+    
+    set xml [lindex $bboxleft 0]
+    set yml [lindex $bboxleft 1]
+    set xpl [lindex $bboxleft 2]
+    set ypl [lindex $bboxleft 3]
+    
+    set dxl [expr {$xpl-$xml}]
+    set dyl [expr {$ypl-$yml}]
+    set mid_xl [expr {0.5*($xpl+$xml)}]
+    set mid_yl [expr {0.5*($ypl+$yml)}]
+    
+    set hoval 15
+    if {$bboxright != ""} {
+        set xmr [lindex $bboxright 0]
+        set ymr [lindex $bboxright 1]
+        set xpr [lindex $bboxright 2]
+        set ypr [lindex $bboxright 3]
+        
+        
+        set dxr [expr {$xpr-$xmr}]
+        set dyr [expr {$ypr-$ymr}]
+        set mid_xr [expr {0.5*($xpr+$xmr)}]
+        set mid_yr [expr {0.5*($ypr+$ymr)}]
+        #$wincan create oval [expr {$mid_xr-0.3*$dxr}] [expr {$mid_yr-0.3*$dxr}] [expr {$mid_xr+0.3*$dxr}] [expr {$mid_yr+0.3*$dxr}] -fill [shadeColor [grapher_color right] 0.8] -outline [shadeColor [grapher_color right] 0.5] -tags "right graph circles"
+        #$wincan create oval [expr {$mid_xl-0.3*$dxl}] [expr {$mid_yl-0.3*$dxl}] [expr {$mid_xl+0.3*$dxl}] [expr {$mid_yl+0.3*$dxl}] -fill [shadeColor [grapher_color left] 0.8] -outline [shadeColor [grapher_color left] 0.5] -tags "left graph circles"
+        $wincan create oval -$hoval -$hoval $hoval $hoval -fill [shadeColor [grapher_color right] 0.8] -outline [shadeColor [grapher_color right] 0.5] -tags "right graph circles"
+        $wincan create oval -$hoval -$hoval $hoval $hoval -fill [shadeColor [grapher_color left] 0.8] -outline [shadeColor [grapher_color left] 0.5] -tags "left graph circles"
+        
+        
+        canvas_text_vector $wincan [expr {$mid_xr-0.5*$dxr}] [expr {$mid_yr+0.5*$dyr+ 10}] $widgetInfo($address-filerootname2)  ne 10 0 [grapher_color right] "graph right"
+        canvas_text_vector $wincan [expr {$mid_xl+0.5*$dxl}] [expr {$mid_yl+0.5*$dyl+ 10}] $widgetInfo($address-filerootname1)  nw 10 0 [grapher_color left] "graph left"
+        
+        # centering graphs
+        $wincan move right [expr {-$mid_xr+0.5*$dxr+10}] [expr {-$mid_yr}]
+    } else {
+        #$wincan create oval [expr {$mid_xl-0.3*$dxl}] [expr {$mid_yl-0.3*$dxl}] [expr {$mid_xl+0.3*$dxl}] [expr {$mid_yl+0.3*$dxl}] -fill [shadeColor black 0.8] -outline [shadeColor black 0.5] -tags "left graph circles"
+        $wincan create oval -$hoval -$hoval $hoval $hoval -fill [shadeColor black 0.8] -outline [shadeColor black 0.5] -tags "left graph circles"
+        canvas_text_vector $wincan [expr {$mid_xl}] [expr {$mid_yl+0.5*$dyl+ 10}] $widgetInfo($address-filerootname)  center 10 0 black "graph left"
+    }
+    
+    # add oval behind
+    $wincan lower "circles"
+    
+    # centering graphs
+    $wincan move left  [expr {-$mid_xl-0.5*$dxl-10}] [expr {-$mid_yl}]
+    
+     
+}
+
+proc grapher_color {tag} {
+    set color black
+
+    switch $tag {
+        "left" {
+            set color chocolate
+        }
+        "right" {
+            set color purple
+        }
+        "both" {
+            set color grey20
+        }
+        "treeval" {
+            set color DarkBlue
+        }
+        
+        "default" {
+            set color black
+        }
+    }
+}
+
+
+proc grapher_init_treeview {win address tv type} {
+    global widgetInfo
+    
+    $tv tag configure "value" -background red -foreground white
+    $tv tag configure "children" -background green -foreground white
+    
+    
+    # clean treeview
+    if {[$tv exists "dataset"]} {
+        foreach child [$tv children "dataset"] {
+             $tv delete $child
+        }
+        
+    } else {
+        $tv insert {} end -id "dataset" -text "dataset" -open true
+    }
+    
+    switch $type {
+        "single" {
+            set widgetInfo($address-tvopen) "true"
+           
+            $tv heading 0 -text "Value"
+            $tv heading 1 -text ""
+            $tv column 0 -anchor center
+            $tv column 1 -anchor center
+            
+            
+           }
+        "double" {
+            set widgetInfo($address-tvopen) "false"
+            
+            $tv heading 0 -text "Left Value"
+            $tv heading 1 -text "Right Value"
+            $tv column 0 -anchor center
+            $tv column 1 -anchor center
+            
+        }
+    }
+    
+}
+
+proc grapher_array_to_treeview {win address tv arrayname dsaddress} {
+    global widgetInfo 
+    upvar $arrayname dataset
+    
+    grapher_setup_XML dataset $dsaddress
+    
+    foreach child $dataset($dsaddress-children) {
+        
+        set title  [grapher_gettitle_of_child dataset "$dsaddress.$child" ] 
+        
+        set lvl [llength [split "$dsaddress.$child" "."] ]
+        grapher_html_write_table  $address [list $title $dataset($dsaddress.$child-value)] default $lvl
+        
+        $tv insert $dsaddress end -id $dsaddress.$child -text $title -values "{$dataset($dsaddress.$child-value)} {}" -open $widgetInfo($address-tvopen)
+        grapher_array_to_treeview $win $address $tv dataset $dsaddress.$child
+    }
+    
+    
+}
+
+proc grapher_gettitle_of_child { arrayname dsaddress } {
+    global tmpXMLtree
+    upvar $arrayname dataset
+    
+    # get last item
+    set last [lindex [split $dsaddress "."] end]
+    
+    
+    # build XMLaddress
+    set XMLaddress  "root [dTree_cleanKey [lrange [ split "$dsaddress" "." ] 1 end ]] "
+            
+    # remove item, a lavel which does not exists in XML tree
+    if {[lsearch $XMLaddress "item"]} {
+        lremove XMLaddress "item"
+    }
+    
+    # If title exist , set it
+    if {[dTree_attrExists $tmpXMLtree $XMLaddress "title"]} {
+        set title [dTree_getAttribute $tmpXMLtree $XMLaddress "title"]
+    } else {
+        #puts "$dsaddress without title"
+        set title [string totitle $last]
+    }
+    
+    # case of named nultiple
+    if {[lindex [split $last "_"] 0] == "item"} {
+        set title "$dataset($dsaddress-value)"
+    }
+    
+    
+    return $title
+}
+
+proc grapher_setup_XML {arrayname dsaddress} {
+    global tmpXMLtree widgetInfo
+    upvar $arrayname dataset
+    
+    if { $dsaddress == "dataset"} {
+        set appli $dataset($dsaddress-children)
+        if {$appli in $widgetInfo(applicationList)} {
+            log "Loading XML of $appli"
+            set modelPath [file join  $widgetInfo(libraryPath) $appli XML]
+            set dataPath [file join $widgetInfo(libraryPath)]
+            set tmpXMLtree ""
+            OpenTeaXMLML2tree tmpXMLtree $modelPath $dataPath
+        }
+    }
+
+}
+
+proc grapher_create { win address wincan wintv folder file1 file2 dump} {
+    global widgetInfo
+    
+    set widgetInfo($address-wincan) $wincan
+    set widgetInfo($address-wintv) $wintv
+    set widgetInfo($address-folder) $folder
+    set widgetInfo($address-dump) $dump
+    
+    # cleaning
+    $wincan delete all
+   
+    #  scroll
+    bind $wincan   <ButtonPress> [subst {$wincan scan mark %x %y}]
+    bind $wincan   <B1-Motion> [subst {$wincan scan dragto %x %y 1}]
+    
+    if {$file1 == $file2} {
+        grapher_init_treeview $win $address $wintv "single"
+        set widgetInfo($address-filerootname) $file1
+        grapher_html_write_table  $address "Exploring simulation" start
+        grapher_html_write_table  $address "Element $file1 " headers
+        
+        grapher_loadfile "ds1" [file join $folder "$file1.dat"]
+        grapher_array_to_treeview $win $address $wintv "ds1" "dataset"
+        grapher_fill $address  "ds1" "dataset" 0 1
+        grapher_trace $address  "ds1"  {0 0 10.0} "dataset" left
+        grapher_bboxgraphs $address
+    } else {
+        grapher_init_treeview $win $address $wintv "double"
+        set widgetInfo($address-filerootname) "$file1\_VS_$file2"
+        set widgetInfo($address-filerootname1) "$file1"
+        set widgetInfo($address-filerootname2) "$file2"
+        set widgetInfo($address-mismatch) 0
+        grapher_html_write_table  $address "Comparing simulations " start
+        grapher_html_write_table  $address "Element $file1 $file2" headers
+        
+        grapher_loadfile "ds1" [file join $folder "$file1.dat"]
+        grapher_loadfile "ds2" [file join $folder "$file2.dat"]
+        grapher_fill $address "ds1" "dataset" 0 0 
+        grapher_fill $address "ds2" "dataset" 0 0
+        grapher_compare $address "ds1" "ds2" "dataset" {0 0 10.0} {0 0 10.0}
+        grapher_bboxgraphs $address
+    }
+    
+    grapher_html_write_table  $address "" end
+        
+    
+   $wincan raise "handle"
+   $wincan configure -scrollregion [ $wincan bbox all]
+   
+
+   
+   
+   if {$dump} {
+     set jobduration [time {
+            set result [canvas_makegif $wincan [file join $folder "$widgetInfo($address-filerootname).gif"]]
+        }]
+        set jobtime [expr { 1.*[lindex $jobduration 0]/ 1000000}]
+    debug "Gif created in $jobtime s"
+   }
+
+}
+
+
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/load_save.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/load_save.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/load_save.tcl	(revision 4775)
@@ -0,0 +1,403 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+proc loadProject {fileName } {
+    global widgetInfo loadedProject workingDir
+    global DStree metaTree 
+    
+    
+    # start timer
+    set load_start_time [clock milliseconds]
+    
+    
+    # load projet into a loadtree
+    dTree_init loadTree
+    
+    
+   
+    
+    xml2tree $fileName loadTree "DStree"    
+    set loadedProject $fileName
+    updateTitle
+    cd [file dirname $loadedProject]
+    # If it doesn't exist, create directory according to file name
+    set dirName [file tail [file rootname $fileName]]
+    if {$widgetInfo(classApp) != "nanoapp"} {
+        if {![file exists $dirName]} {
+            file mkdir $dirName
+        }
+        cd $dirName
+    }           
+    set workingDir [pwd]             
+
+  
+    startup_log_channel
+    
+    
+    # Moving meta into metaTree
+    # Moving dataset into DStree
+    dTree_init DStree
+    
+    if {[dTree_nodeExists $loadTree "root dataset"] && [dTree_nodeExists $loadTree "root dataset meta"]} {
+        dTree_init metaTree        
+        dTree_moveBranch loadTree "root dataset meta" metaTree "root"
+        foreach child [dTree_getChildren $loadTree "root dataset"] {
+            dTree_moveBranch loadTree "root dataset $child" DStree "root"
+        }
+    }
+     
+   
+    RefreshFamily "root"
+    set nb_of_validations 1
+    for {set x 0} {$x < $nb_of_validations } {incr x} {
+        CheckValidationStatus "root"
+    }
+        
+    # update Meta data
+    dTree_setAttribute metaTree "root meta project address" "value" "[file normalize $fileName]"        
+    dTree_setAttribute metaTree "root meta project name" "value" "[file tail [file rootname $fileName]]"     
+    
+    # monitor time
+    set load_stop_time [clock milliseconds]
+    set msgloadtime "Loading time : [printtime $load_start_time $load_stop_time ] s."
+    puts $msgloadtime
+    log $msgloadtime
+   
+}
+
+
+proc startup_log_channel {} {
+    global workingDir log_channel loadedProject loadApplication
+
+    if {$log_channel != "stdout"} {
+        close $log_channel
+    }
+    set log_channel [ open [file join $workingDir "trace.log"] a+ ]
+    
+    fconfigure $log_channel -blocking 0 
+    
+    puts $log_channel  "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
+    puts $log_channel  "Application $loadApplication"
+    puts $log_channel  "Project  $loadedProject"
+    puts $log_channel  "Date   [clock format [clock seconds]]"
+    puts $log_channel  "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"
+    
+   
+}
+
+proc loadProject_as_part {fileName } {
+    global widgetInfo loadedProject workingDir
+    global DStree metaTree
+    
+    Start_think ""
+    # start timer
+    set load_start_time [clock milliseconds]
+    
+    
+    # load projet into a loadtree
+    dTree_init loadTree
+    
+    
+    ####################################
+    # fork btw CSV and XML , deprecated
+    # set fileExtension [string tolower [file extension $fileName]]    
+    #if  $fileExtension == ".xml"
+    ####################################
+    
+    
+    xml2tree $fileName loadTree "DStree"    
+    
+    
+    
+    
+    set ProjectToAdd $fileName
+    updateTitle
+    set filesToCopy [glob -nocomplain -directory [file rootname $ProjectToAdd] "*"]
+    
+    foreach subfile $filesToCopy {
+        debug "Copying  $subfile in $workingDir ..."
+        if {[catch { file copy -force $subfile $workingDir } pbcopy ]} {
+            warning "$pbcopy"
+        }
+    }
+    
+    ####################################
+    # fork btw CSV and XML , deprecated
+    #if  $fileExtension == ".xml"
+    #elseif $fileExtension == ".csv"
+    #if $loadedProject == "none"
+    #    error "An xml project needs to be first loaded"
+    #    return   
+    #csv2tree $fileName loadTree
+    ####################################
+    
+    
+    
+    # Moving meta into metaTree
+    # Moving dataset into dummy tree
+    dTree_init dummyTree    
+    if {[dTree_nodeExists $loadTree "root dataset"] } {
+        foreach child [dTree_getChildren $loadTree "root dataset"] {
+            dTree_moveBranch loadTree "root dataset $child" dummyTree "root"
+        }
+    }
+    
+    
+    
+    
+    # compare the present tree with the loaded tree
+    set refreshList ""
+    set comparisonList ""
+    dTree_compareBranch $DStree $dummyTree "root" 0 comparisonList
+    # Merging first and fourth list 
+    set modificationList [lsort -unique [concat [lindex $comparisonList 0] [lindex $comparisonList 1]]]
+    
+    
+    # Applying differences
+    foreach addr [lsort -unique [lindex $modificationList]] {
+        debug ">>> Grafting branch on current memory : [lindex $addr end] ..."
+        
+        dTree_copyBranch dummyTree $addr DStree [lrange $addr 0 end-1]
+    }
+    RefreshFamily "root"
+    CheckValidationStatus "root"
+    
+    
+    # monitor time
+    set load_stop_time [clock milliseconds]
+    set msgloadtime "Loading time : [printtime $load_start_time $load_stop_time ] s."
+    puts $msgloadtime
+    log $msgloadtime
+    Stop_think normal
+   
+}
+
+
+
+
+
+
+
+
+
+proc loadDataset {fileName} {
+    global DStree
+    global metaTree
+    global tmpTree
+    
+    dTree_init loadTree
+    parseFile $fileName loadTree "" "DStree"
+    
+    dTree_init metaTree
+    dTree_rmBranch loadTree "root dataset meta config"
+    dTree_moveBranch loadTree "root dataset meta" metaTree "root"    
+    
+    #dTree_rmBranch loadTree "root dataset DATA"
+    
+    dTree_init dummyTree
+    foreach child [dTree_getChildren $loadTree "root dataset"] {
+        dTree_moveBranch loadTree "root dataset $child" dummyTree "root"
+    }    
+    
+    
+    set refreshList ""
+    
+    set comparisonList ""
+    dTree_compareBranch $tmpTree $dummyTree "root" 1 comparisonList
+    
+    # Merging first and fourth list 
+    set modificationList [lsort -unique  [concat [lindex $comparisonList 0] [lindex $comparisonList 3]]]  
+    
+    
+    # Detecting if all the tree is to be copied 
+    if {[lsearch -exact $modificationList "root"] != -1} {
+        set DStree $dummyTree
+        RefreshFamily "root"
+        for {set x 0} {$x < $::NUMBER_OF_VALIDATION } {incr x} {
+            CheckValidationStatus "root"
+        }           
+        return
+    }
+
+    # Applying Differences
+    foreach addr  $modificationList {
+        dTree_copyBranch dummyTree $addr DStree [lrange $addr 0 end-1]
+    }
+    
+    # We need to reconstruct interface (multiple which depends on an unknown list have to be initialized)
+    foreach a  $modificationList {    
+        set addr [tree2gui $a]
+        RefreshFamily "$addr"
+        CheckValidationStatus "$addr"
+    }    
+    
+}
+
+
+
+
+
+proc saveProject { where filetype mode } {
+    # "where" : self or filename, for save as or save
+    # "filetype" : csv and xml
+    # "mode" : all , green only
+    
+    
+    global DStree metaTree tmpTree
+    global loadApplication loadedProject widgetInfo workingDir log_channel
+    
+    
+    
+    # build saveTree
+    set saveTree ""
+    dTree_init saveTree
+    dTree_addNode saveTree "root" "dataset"
+    switch $mode {
+        "all" {
+            foreach child [dTree_getChildren $tmpTree "root"] {
+                dTree_copyBranch tmpTree "root $child" saveTree "root dataset"
+            }
+        }
+        "greenonly" {
+            foreach child [dTree_getChildren $tmpTree "root"] {
+                dTree_copyBranch DStree "root $child" saveTree "root dataset"
+            }
+        }
+        default {
+            error "saveProject mode $mode not understood"
+        }
+    }
+    
+    
+   switch $where {
+        "self" {
+            set fileName $loadedProject
+            log "Saving Project in file $fileName "
+        }
+        default {
+            set fileName $where
+            log "Saving Project As file $fileName "
+        }
+    }
+   
+   
+    
+       
+    
+    # re-setting the projet   
+    #newRecentProject $fileName $loadApplication
+    set loadedProject $fileName  
+    updateTitle            
+    cd [file dirname $loadedProject]
+    # If it doesn't exist, we create directory according to file name
+    set dirName [file tail [file rootname $fileName]]
+    if {$widgetInfo(classApp) != "nanoapp" } {
+        if {![file exists $dirName]} {
+            file mkdir $dirName
+        }
+        cd $dirName
+    }                
+
+    dTree_setAttribute metaTree "root meta project name" "value" "[file tail [file rootname $fileName]]"        
+    dTree_setAttribute metaTree "root meta project address" "value" "[file normalize $fileName]"
+    dTree_copyBranch metaTree "root meta" saveTree "root dataset"
+   
+    set workingDir [pwd]
+    
+    
+    switch $where {
+        "self" {
+            flush $log_channel
+        }
+        default {
+            startup_log_channel
+        }
+    }
+    
+    
+    # actual saving
+    switch $filetype {
+        "xml" {
+            tree2xml $fileName $saveTree
+        }
+        "csv" {
+            tree2csv $fileName $saveTree
+        }
+        default {
+             error "saveProject filetype $filetype not understood"
+        }
+    }
+}
+
+proc saveDataset {file callingAddress} {
+    global metaTree configTree tmpTree XMLtree loadedProject
+    global configPath
+    fill_metaTree
+    set pipeTree ""
+    dTree_init pipeTree
+    dTree_addNode pipeTree "root" "dataset"
+    dTree_setAttribute metaTree "root meta project name" "value" "[file tail [file rootname $loadedProject]]"        
+    dTree_setAttribute metaTree "root meta project address" "value" "[file normalize $loadedProject]"
+    dTree_copyBranch metaTree "root meta" pipeTree "root dataset"
+    
+    dTree_setAttribute pipeTree "root dataset meta scriptSuccess" "value" 1
+    dTree_setAttribute pipeTree "root dataset meta action callingAddress" "value" $callingAddress
+    
+    
+    # Adding DATA
+    #dTree_copyBranch XMLtree "root DATA" pipeTree "root dataset"
+    
+    
+    # Adding extra-informations
+    
+    dTree_init configTree
+    if {[file exists $configPath]} {
+        parseFile $configPath configTree "" "DStree"
+        dTree_copyBranch configTree "root dataset config" pipeTree "root dataset meta"
+    } else {
+        close [open $configPath "w"]
+    }    
+    
+    
+    foreach child [dTree_getChildren $tmpTree "root"] {
+        dTree_copyRelevantBranch tmpTree "root $child" pipeTree "root dataset"           
+    }
+    
+    tree2xml $file $pipeTree    
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.py
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.py	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.py	(revision 4775)
@@ -0,0 +1,1450 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+# the purpose of this program is to add headers and footers for Licensing sources.
+# Its far from generic 
+
+
+import os
+import random
+import string
+import glob
+
+path=os.getcwd()
+nameraw=os.listdir(path)
+name = []
+for item in nameraw:
+    if os.path.isfile(item):
+        if not item.startswith('.'):
+            if not item.startswith('mapping'):
+                name.append(item)  
+            
+
+fileExtension=[{} for i in range(len(name))]
+fileName=[{} for i in range(len(name))]
+completeName=[{} for i in range(len(name))]
+
+# initialisation
+
+
+year ="2014"
+company= "CERFACS"
+headerdb={}
+headerdb["licences"]=[]
+
+content="""Copyright """+company+" "+year+"""
+ 
+antoine.dauptain@cerfacs.fr
+ 
+This software is a computer program whose purpose is to ensure technology
+transfer between academia and industry.
+ 
+This software is governed by the CeCILL-B license under French law and
+abiding by the rules of distribution of free software.  You can  use, 
+modify and/ or redistribute the software under the terms of the CeCILL-B
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info". 
+ 
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability. 
+ 
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or 
+data to be ensured and,  more generally, to use and operate it in the 
+same conditions as regards security. 
+ 
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL-B license and that you accept its terms."""
+
+headerdb["licences"].append("cecill")
+headerdb["cecill","header"] = "This program is under CECILL_B licence. See footer for details."
+headerdb["cecill","footer"] = content.split("\n")
+headerdb["cecill","name"] = "Cecill-B"
+
+
+content="""Copyright """+company+" "+year+"""
+ 
+antoine.dauptain@cerfacs.fr
+ 
+This software is a computer program whose purpose is to ensure technology
+transfer between academia and industry.
+ 
+This software is governed by a OpenScience license.
+You can  use,  modify and/ or redistribute the software.
+ 
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights. 
+ 
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or 
+data to be ensured and,  more generally, to use and operate it in the 
+same conditions as regards security. 
+ 
+The fact that you are presently reading this means that you have had
+knowledge of the OpenScience license and that you accept its terms"""
+
+headerdb["licences"].append("openscience")
+headerdb["openscience","header"] = "This program is under OpenScience licence. See footer for details"
+headerdb["openscience","footer"] = content.split("\n")
+headerdb["openscience","name"] = "openscience"
+
+
+content="Copyright CERFACS-IFP-SAFRAN "+year+"""
+ 
+antoine.dauptain@cerfacs.fr
+ 
+Ce logiciel est un programe informatique dont l'objectif est de proposer
+des outils numeriques pour l'etude de la combustion, des turbomachines,
+de l'acoustique, de la thermique et du rayonmment.
+ 
+Ce logiciel est gouverne par l'ACCORD DE COOPERATION AVBP (N. IFP 31.293)
+sous loi francaise, et fait explicitement partie de la -version commune- d'AVBP.
+ 
+Ce logiciel est la copropriete de CERFACS, SAFRAN et l'IFPEN, nommees ci apres les Parties,
+dans les termes de l'ACCORD DE COOPERATION AVBP.
+En cela:
+-  Chaque Partie pourra utiliser la -version commune- du code AVBP
+incluant la modalite 1 et la modalite 2 pour ses besoins propres
+de recherche librement, gratuitement, et sans limitation de duree.
+Par besoins propres de recherche, on entend une utilisation en
+interne de la -version commune- du code AVBP par une Partie pour
+des activites commerciales.
+ 
+-le CERFACS et l'IFPEN pourront librement entreprendre l'exploitation
+commerciale de la -version commune- du code AVBP incluant la modalite 1
+et la modalite 2 en toute independance et gratuitement a l'egard de
+l'autre partie, sous reserve de ne pas l'utiliser au profit de concurrents
+de SAFRAN ni de la diffuser a des tiers sous quelque forme que ce soit.
+ 
+-SAFRAN pourra exploiter librement la -version commune- du code AVBP
+incluant la modalite 1 dans le cadre de son activite d'etude et de
+conception de ses produits, sous reserve de ne pas l'utiliser au profit
+de concurrents du CERFACS et le l'IFP, ni de la diffuser a des tiers
+sous quelque forme que ce soit.
+ 
+L'utilisation de la -version commune- du code AVBP sera aux seuls
+risques de la partie exploitante et sous la seule responsabilite de
+la dite Partie. La -version commune- et toute documentation eventuelle
+y afferente sont fournis en l'etat, sans garantie d'aucune sorte.
+Nottament, aucune garantie en ce qui concerne l'utilisation initerrompue
+du code, ou les resultats obtenus lors de l'utilisation de la
+-version commune-, que ce soit leur exactitude, fiabilite ou autre,
+ou la jouissance paisible de la -version commune- n'est donnee.
+En consequence chacune des parties renonce a tout recours vis a vis des
+autres parties en ce qui concerne les consequences resultant de
+l'utilisation de la -version commune-, de quelque nature que ce soit. 
+ 
+A cet egard  l'attention de l'utilisateur est attiree sur les risques
+associes au chargement,  a l'utilisation,  a la modification et/ou au
+developpement et a la reproduction du logiciel par l'utilisateur etant 
+donne sa specificite de logiciel scientifique, qui peut le rendre complexe a 
+manipuler et qui le reserve donc a des developpeurs et des professionnels
+avertis possedant  des  connaissances  informatiques approfondies. Les
+utilisateurs sont donc invites a charger et tester l'adequation  du
+logiciel a leurs besoins dans des conditions permettant d'assurer la
+securite de leurs systemes et ou de leurs donnees et, plus generalement, 
+a l'utiliser et l'exploiter dans les memes conditions de securite. 
+ 
+Le fait que vous puissiez acceder a cet en-tete signifie que vous avez 
+pris connaissance de l'ACCORD DE COOPERATION AVBP, et que vous en avez
+accepte les termes."""
+
+headerdb["licences"].append("accordAVBP")
+headerdb["accordAVBP","header"] = "Ce programme depend des accords l'ACCORD DE COOPERATION AVBP (N. IFP 31.293). Voir la fin du programme pour plus de details."
+headerdb["accordAVBP","footer"] = content.split("\n")
+headerdb["accordAVBP","name"] = "accordAVBP"
+
+mapping=""
+
+ii=0
+_python=0
+_fortran=0
+_tcl=0
+_html=0
+_XML=0
+_others=0
+_files=0
+_cecill=0
+_cerfacs=0
+_openscience=0
+
+if os.path.isfile('mapping.txt'):
+    fichier=open('mapping.txt',"r")
+    mapp=fichier.read().split("\n")
+    fichier.close()
+    for i in range(len(name)):
+        (fileName[i], fileExtension[i]) = os.path.splitext(name[i])
+        completeName[i]=path + '/' + fileName[i]
+    for i in range(len(name)):
+        fichier=open(fileName[i]+fileExtension[i],"r")
+        contenu=fichier.read().split("\n")
+        fichier.close()
+        contenu3=""
+        _files=_files+1
+        
+# Boucle global
+        
+        if completeName[i] in mapp[ii]:
+
+            ##### Compte Lincences #####
+            
+            if 'CERFACS' in mapp[ii]:
+                _cerfacs=_cerfacs+1
+            elif 'CECILL' in mapp[ii]:
+                _cecill=_cecill+1
+            elif 'OPENSCIENCE' in mapp [i]:
+                _openscience=_openscience+1
+            
+# Extension python
+            
+            if fileExtension[i]=='.py':
+                
+                _python=_python+1
+                
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))
+                
+                ##### CERFACS #####
+                
+                if 'CERFACS' in mapp[ii]:
+                    
+                    ###### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CERFACS'
+                    
+                    
+                ##### CECILL #####
+                            
+                elif 'CECILL' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["cecill","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["cecill","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["cecill","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CECILL'
+                    
+                    
+                ##### OPENSCIENCE #####
+                
+                elif 'OPENSCIENCE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["openscience","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["openscience","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["openscience","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / OPENSCIENCE'
+                 
+                 
+                ##### Pas de licence #####
+                
+                elif 'NONE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program is under CECILL_B"):
+                        contenu.remove("#  "+headerdb["cecill","header"])
+                    elif contenu[0].startswith("#  This program is under OpenScience"):
+                        contenu.remove("#  "+headerdb["openscience","header"])
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu.remove("#  "+headerdb["accordAVBP","header"])
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                            
+                    mapping += ' / NONE'
+                    
+                else:
+                    mapping += ' / PRE NONE'
+                    
+                ##### Ecriture #####
+                
+                mapping += '\n'
+                    
+                for k in range(len(contenu)):
+                    contenu[k]=contenu[k]+'\n'
+                    contenu3+=contenu[k]
+                    
+# Extension Fortran
+                        
+            elif fileExtension[i]=='.f90':
+                
+                _fortran=_fortran+1
+                
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))
+                
+                ##### CERFACS #####
+                
+                if 'CERFACS' in mapp[ii]:
+                    
+                    ###### Header #####
+                    
+                    if contenu[0].startswith("!  This program"):
+                        contenu[0]="!  "+headerdb["accordAVBP","header"]
+                    elif contenu[0].startswith("!  Ce programme"):
+                        contenu[0]="!  "+headerdb["accordAVBP","header"]
+                    else:
+                        contenu[0]="!  "+headerdb["accordAVBP","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("!  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("!  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("!  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("!  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CERFACS'
+                    
+                    
+                ##### CECILL #####
+                            
+                elif 'CECILL' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("!  This program"):
+                        contenu[0]="!  "+headerdb["cecill","header"]
+                    elif contenu[0].startswith("!  Ce programme"):
+                        contenu[0]="!  "+headerdb["cecill","header"]
+                    else:
+                        contenu[0]="!  "+headerdb["cecill","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("!  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("!  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("!  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("!  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CECILL'
+                    
+                    
+                ##### OPENSCIENCE #####
+                
+                elif 'OPENSCIENCE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("!  This program"):
+                        contenu[0]="!  "+headerdb["openscience","header"]
+                    elif contenu[0].startswith("!  Ce programme"):
+                        contenu[0]="!  "+headerdb["openscience","header"]
+                    else:
+                        contenu[0]="!  "+headerdb["openscience","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("!  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("!  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("!  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("!  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n!  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / OPENSCIENCE'
+                    
+                ##### Pas de licence #####
+                
+                elif 'NONE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("!  This program is under CECILL_B"):
+                        contenu.remove("!  "+headerdb["cecill","header"])
+                    elif contenu[0].startswith("!  This program is under OpenScience"):
+                        contenu.remove("!  "+headerdb["openscience","header"])
+                    elif contenu[0].startswith("!  Ce programme"):
+                        contenu.remove("!  "+headerdb["accordAVBP","header"])
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("!  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("!  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("!  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("!  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("!  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                            
+                    mapping += ' / NONE'
+                    
+                else:
+                    mapping += ' / PRE NONE'
+                            
+                ##### Ecriture #####
+                
+                mapping += '\n'
+                    
+                for k in range(len(contenu)):
+                    contenu[k]=contenu[k]+'\n'
+                    contenu3+=contenu[k]
+                    
+                    
+                    
+########## Extension tcl ##########
+                
+            elif fileExtension[i]=='.tcl':
+                
+                _tcl=_tcl+1
+                
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))
+                
+                ##### CERFACS #####
+                
+                if 'CERFACS' in mapp[ii]:
+                    
+                    ###### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["accordAVBP","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CERFACS'
+                    
+                    
+                ##### CECILL #####
+                            
+                elif 'CECILL' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["cecill","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["cecill","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["cecill","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["cecill","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / CECILL'
+                    
+                    
+                ##### OPENSCIENCE #####
+                
+                elif 'OPENSCIENCE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program"):
+                        contenu[0]="#  "+headerdb["openscience","header"]
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="#  "+headerdb["openscience","header"]
+                    else:
+                        contenu[0]="#  "+headerdb["openscience","header"]+"\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n"
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n#  "+headerdb["openscience","footer"][num]
+                            num=num+1
+                        
+                    mapping += ' / OPENSCIENCE'
+                
+                ##### Pas de licence #####
+                
+                elif 'NONE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("#  This program is under CECILL_B"):
+                        contenu.remove("#  "+headerdb["cecill","header"])
+                    elif contenu[0].startswith("#  This program is under OpenScience"):
+                        contenu.remove("#  "+headerdb["openscience","header"])
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu.remove("#  "+headerdb["accordAVBP","header"])
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-1].startswith("#  accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove("#  "+headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove("#  "+headerdb["cecill","footer"][num])
+                            num=num+1
+                            
+                    elif contenu[len(contenu)-1].startswith("#  knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove("#  "+headerdb["openscience","footer"][num])
+                            num=num+1
+                            
+                    mapping += ' / NONE'
+                    
+                else:
+                    mapping += ' / PRE NONE'
+                    
+                ##### Ecriture #####
+                
+                mapping += '\n'
+                    
+                for k in range(len(contenu)):
+                    contenu[k]=contenu[k]+'\n'
+                    contenu3+=contenu[k]
+                    
+# Extension html
+            
+            elif fileExtension[i]=='.html':
+                
+                _html=_html+1
+                
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))
+                
+                ##### CERFACS #####
+                
+                if 'CERFACS' in mapp[ii]:
+                    
+                    ###### Header #####
+                    
+                    if contenu[0].startswith("<!--  This program"):
+                        contenu[0]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    elif contenu[0].startswith("<!--  Ce programme"):
+                        contenu[0]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    else:
+                        contenu[0]="<!--  "+headerdb["accordAVBP","header"]+"  -->\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / CERFACS'
+                    
+                    
+                ##### CECILL #####
+                            
+                elif 'CECILL' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("<!--  This program"):
+                        contenu[0]="<!--  "+headerdb["cecill","header"]+"  -->"
+                    elif contenu[0].startswith("<!--  Ce programme"):
+                        contenu[0]="<!--  "+headerdb["cecill","header"]+"  -->"
+                    else:
+                        contenu[0]="<!--  "+headerdb["cecill","header"]++"  -->\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["cecill","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / CECILL'
+                    
+                    
+                ##### OPENSCIENCE #####
+                
+                elif 'OPENSCIENCE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[0].startswith("<!--  This program"):
+                        contenu[0]="<!--  "+headerdb["openscience","header"]+"  -->"
+                    elif contenu[0].startswith("#  Ce programme"):
+                        contenu[0]="<!--  "+headerdb["openscience","header"]+"  -->"
+                    else:
+                        contenu[0]="<!--  "+headerdb["openscience","header"]+"  -->\n\n"+contenu[0]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+"\n"+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["openscience","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / OPENSCIENCE'
+                    
+                ##### Pas de licence #####
+                
+                elif 'NONE' in mapp[ii]:
+                    
+                    ##### Header #####
+
+                    if contenu[0].startswith("<!--  This program is under CECILL_B"):
+                        contenu.remove("<!--  "+headerdb["cecill","header"]+"  -->")
+                    elif contenu[0].startswith("<!--  This program is under OpenScience"):
+                        contenu.remove("<!--  "+headerdb["openscience","header"]+"  -->")
+                    elif contenu[0].startswith("<!--  Ce programme"):
+                        contenu.remove("<!--  "+headerdb["accordAVBP","header"]+"  -->")
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                        
+                    elif contenu[len(contenu)-1].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                        
+                    mapping += ' / NONE'
+                    
+                else:
+                    mapping += ' / PRE NONE'
+                            
+                ##### Ecriture #####
+                
+                mapping += '\n'
+                    
+                for k in range(len(contenu)):
+                    contenu[k]=contenu[k]+'\n'
+                    contenu3+=contenu[k]
+                    
+# Extension XML
+                       
+            elif fileExtension[i]=='.xml':
+                
+                _XML=_XML+1
+                
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))
+                
+                # Si declaration xml, pas de commentaires avant
+                
+                gg=0
+                if '?xml' in contenu[0]:
+                        gg=1
+                
+                ##### CERFACS #####
+                
+                if 'CERFACS' in mapp[ii]:
+                    
+                    ###### Header #####
+                     
+                    if contenu[gg+1].startswith("<!--  This program"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    elif contenu[gg+1].startswith("<!--  Ce programme"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    else:
+                        contenu[gg]="\n<!--  "+headerdb["accordAVBP","header"]+"  -->\n\n"+contenu[gg]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["accordAVBP","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / CERFACS'
+                    
+                    
+                ##### CECILL #####
+                            
+                elif 'CECILL' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[gg+1].startswith("<!--  This program"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    elif contenu[gg+1].startswith("<!--  Ce programme"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    else:
+                        contenu[gg]="\n<!--  "+headerdb["accordAVBP","header"]+"  -->\n\n"+contenu[gg]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["cecill","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["cecill","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / CECILL'
+                    
+                    
+                ##### OPENSCIENCE #####
+                
+                elif 'OPENSCIENCE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[gg+1].startswith("<!--  This program"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    elif contenu[gg+1].startswith("<!--  Ce programme"):
+                        contenu[gg+1]="<!--  "+headerdb["accordAVBP","header"]+"  -->"
+                    else:
+                        contenu[gg]="\n<!--  "+headerdb["accordAVBP","header"]+"  -->\n\n"+contenu[gg]
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-2]=contenu[len(contenu)-2]+'\n'+headerdb["openscience","footer"][num]
+                            num=num+1
+                            
+                            
+                    else:
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n\n\n<!--"
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n"+headerdb["openscience","footer"][num]
+                            num=num+1
+                        contenu[len(contenu)-1]=contenu[len(contenu)-1]+"\n-->"
+                        
+                    mapping += ' / OPENSCIENCE'
+                    
+                ##### Pas de licence #####
+                
+                elif 'NONE' in mapp[ii]:
+                    
+                    ##### Header #####
+                    
+                    if contenu[gg+1].startswith("<!--  This program is under CECILL_B"):
+                        contenu.remove("<!--  "+headerdb["cecill","header"]+"  -->")
+                    elif contenu[gg+1].startswith("<!--  This program is under OpenScience"):
+                        contenu.remove("<!--  "+headerdb["openscience","header"]+"  -->")
+                    elif contenu[gg+1].startswith("<!--  Ce programme"):
+                        contenu.remove("<!--  "+headerdb["accordAVBP","header"]+"  -->")
+                        
+                    ##### Footer #####
+                    
+                    if contenu[len(contenu)-2].startswith("accepte"):
+                        num=0
+                        for line in headerdb["accordAVBP","footer"]:
+                            contenu.remove(headerdb["accordAVBP","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                            
+                    elif contenu[len(contenu)-2].startswith("knowledge of the CeCILL-B"):
+                        num=0
+                        for line in headerdb["cecill","footer"]:
+                            contenu.remove(headerdb["cecill","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                        
+                    elif contenu[len(contenu)-1].startswith("knowledge of the OpenScience"):
+                        num=0
+                        for line in headerdb["openscience","footer"]:
+                            contenu.remove(headerdb["openscience","footer"][num])
+                            num=num+1
+                        contenu[len(contenu)-2]=""
+                        contenu[len(contenu)-1]=""
+                        
+                    mapping += ' / NONE'
+                    
+                else:
+                    mapping += ' / PRE NONE'
+                    
+                ##### Ecriture #####
+                
+                mapping += '\n'
+                    
+                for k in range(len(contenu)):
+                    contenu[k]=contenu[k]+'\n'
+                    contenu3+=contenu[k]
+                    
+# Fichiers sans extension ou autre que voulue
+            
+            else:
+                _others=_others+1
+                mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))+' / NONE\n'
+                
+            contenu3=contenu3[0:-1]
+            fichier=open(fileName[i]+fileExtension[i],"w")
+            fichier.write(contenu3)
+            fichier.close()
+                
+            ii=ii+1
+            
+# Si rajout de fichiers
+           
+        else:
+            mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))+' / PRE NONE\n'
+            
+# Ecriture du mapping
+    
+    mapping += '\n\nFiles : \t\t\t\t\t\tLicenses :\n\t- f90 = '+str(_fortran)+' files\t\t\t\t\t\t- Cerfacs = '+str(_cerfacs)+' files\n\t- py = '
+    mapping += str(_python)+' files\t\t\t\t\t\t- CeCILL-B = '+str(_cecill)+' files\n\t- XML = '+str(_XML)+' files\t\t\t\t\t\t- Openscience = '
+    mapping += str(_openscience)+' files\n\t- tcl = '+str(_tcl)+' files\n\t- html = '+str(_html)+' files\n\t- Others = '+str(_others)+' files\n\nTOTAL = '
+    mapping += str(_files)+' files\n\nInfo : PRE --> There still is a header in this file. Please, execute again mapping\n'
+    mapping=mapping[0:-1]
+    fichier=open('mapping.txt',"w")
+    fichier.write(mapping)
+    fichier.close()
+    
+else:
+    for i in range(len(name)):
+        (fileName[i], fileExtension[i]) = os.path.splitext(name[i])
+        completeName[i]=path + '/' + fileName[i]
+        mapping += completeName[i]+" "*(95-len(completeName[i]))+fileExtension[i]+" "*(15-len(fileExtension[i]))+' / PRE NONE\n'
+    fichier=open('mapping.txt',"w")
+    fichier.write(mapping)
+    fichier.close()
+
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.txt
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.txt	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/mapping.txt	(revision 4775)
@@ -0,0 +1,65 @@
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/c3sm                                  .tcl            / CERFACS
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/color_utilities                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/config                                .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_action                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_browser                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_choice                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_cluster                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_comment                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_comparator                     .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_dynlist                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_emptyNode                      .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_entry                          .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_glance                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_graph                          .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_gui                            .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_info                           .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_main                           .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_metaTree                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_modelframe                     .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_modelxor                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_modelxor_light                 .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_multiple                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_scrollform                     .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_selection                      .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_solverframe                    .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_status                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_switch                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_switchform                     .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_tabs                           .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_timeline                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_viewer                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/create_window                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/declare_faq                           .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/declare_icons                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/dTree                                 .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/dTreeBrowser                          .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/functions                             .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/functions_help                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/functions_theme                       .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/genPyFromXMLtree                      .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/grapher_utilities                     .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/load_save                             .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/metaWidget_functions                  .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/openpipe                              .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/opentea                               .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/recentProjects                        .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/smartpacker                           .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/test_vartypes                         .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/treeAnalyser                          .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/unwrapped                             .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/wrapper                               .tcl            / CECILL
+/Volumes/Data/Users/dauptain/Documents/DepotGIT/dev/c3sm/XMLparser                             .tcl            / CECILL
+
+
+Files : 						Licenses :
+	- f90 = 0 files						- Cerfacs = 1 files
+	- py = 0 files						- CeCILL-B = 51 files
+	- XML = 0 files						- Openscience = 0 files
+	- tcl = 52 files
+	- html = 0 files
+	- Others = 0 files
+
+TOTAL = 52 files
+
+Info : PRE --> There still is a header in this file. Please, execute again mapping
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/metaWidget_functions.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/metaWidget_functions.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/metaWidget_functions.tcl	(revision 4775)
@@ -0,0 +1,761 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+        
+################
+proc read_arguments { } {
+    uplevel 1 {} {
+        global XMLtree
+        global DStree
+       
+        # loop on keywords provided
+        foreach { keyword argument } $args {
+            # test keywords
+            if {![string match -* $keyword ]} {
+                tk_messageBox -icon error -message "Error : keyword must be like -*"
+                return
+            }
+    
+            set varname [ string trim $keyword "-"]
+            set $varname $argument
+        }
+        
+        # test if mandatory arguments are set
+        foreach argument $mandatory_arguments  {
+            if {![info exists $argument]} {
+                tk_messageBox -icon error -message  "Cannot create widget : $argument is missing"
+                return
+            }
+        }
+        
+        # Process address from arguments to get nodes and attribute
+        set full_address_XML [split $address "."]
+	set full_address_XML_clean [ dTree_cleanKey $full_address_XML ]
+	
+        set name [lindex $full_address_XML end ]
+        set nodes [lrange $full_address_XML 0 end-1 ]
+        
+        set nodeType ""
+        catch {set nodeType [dTree_getAttribute_fast $XMLtree "$full_address_XML" "nodeType"]}
+        
+    }
+}
+
+
+
+################
+# This procedure must be called by all metaWidgets to get the correct behavior in the IHM
+#   before anything else
+#                                       no exceptions!
+################
+proc initWidget { } {
+    
+    uplevel 1 { } {
+        # Get access to the central data tree
+        global GuiInfo
+        global widgetInfo loading
+        global DStree tmpTree
+        global initializedSolver
+        read_arguments
+        
+        ################
+        # widgetInfo Initializations
+        ################
+        
+        # set the status on OK by default
+        set widgetInfo($address-status) 0
+       
+	
+        # initialize the check/refrech/refreshStatus methods
+        set widgetInfo($address-check)   ""
+        set widgetInfo($address-refresh) ""
+        set widgetInfo($address-require) ""
+        set widgetInfo($address-refreshStatus) ""
+        set widgetInfo($address-variable) ""
+	set widgetInfo($address-visible) 1
+        set widgetInfo($address-editable) 1
+        
+        set widgetInfo($address-visibility) [dTree_tryGetAttribute $XMLtree "$full_address_XML" "visibility"  "shown"]
+                
+        # keep track of the GUI root of the widget
+        set widgetInfo($address-win) $path_father.$name
+        set win $widgetInfo($address-win)
+     
+     
+	# initialize the documentation preferences
+	set docu_prefered_side "bottom"
+	set docu_prefered_place $win
+     
+        set widgetInfo($address-name) $name
+        switch $widgetInfo(guimode) {
+	    "treeview" {
+                set widgetInfo(packme-$win) [subst {
+                    pack $win  -anchor nw -side top -pady 10
+                }]
+	    }
+	    "multicolumn" {
+                set widgetInfo(packme-$win) [subst {
+                    set widgetInfo(fixedview) 1
+                    pack $win  -expand 1 -fill x
+                    event generate . <<SetView>>
+                    set widgetInfo(fixedview) 0
+                }]
+	    }
+        }
+       
+        # unpackme method
+        set widgetInfo(unpackme-$win) [subst {
+            pack forget $win
+        }]
+        
+        
+        
+        
+        
+        
+        # inherit attributes from parents
+        foreach parent [lrange [addrGetAncestors $address] 0 end-1] {
+            if {$widgetInfo($parent-editable) == 0} {
+                set widgetInfo($address-editable) 0
+                #log "> Herits : $address can't be edited"
+            }
+        } 
+        
+        ## basic/expert
+        #if {[dTree_attrExists $XMLtree "$full_address_XML" "level"] == 1} {
+        #    if {[getConfig "config id user expert"] != "1" && [dTree_getAttribute $XMLtree "$full_address_XML" "level"]=="expert"} {
+        #        set widgetInfo($address-editable) 0
+        #        #log "> $address can't be edited"
+        #    }
+        #}
+        
+        # dependsOn
+        if  {[dTree_attrExists $XMLtree $full_address_XML_clean "dependson"]==1} {
+            set rawDependsOn [dTree_getAttribute_fast $XMLtree $full_address_XML_clean "dependson"]
+            set rawDependsOn [split $rawDependsOn ";"]
+            set listDependsOn ""            
+            foreach node $rawDependsOn {
+                set possibleAddresses [dTree_searchNode $XMLtree $node]
+                if {[llength $possibleAddresses] != 1} {
+                    set newNode "$initializedSolver $node"
+                    set possibleAddresses [dTree_searchNode $XMLtree $newNode]
+                    if {[llength $possibleAddresses] != 1} {
+                        error "Keywords $newNode have not given relevant results\n Results :\n $possibleAddresses"
+                    }
+                }
+                                    
+                set addressDependsOn [lindex $possibleAddresses 0]
+                
+                bind . <<statusChanged-[tree2gui $addressDependsOn]>> +[subst {
+                    set widgetInfo($address-status) 0
+                    eval \$widgetInfo($address-refreshStatus)
+                    catch { 
+                        # In case of an action or tab widget
+                         set widgetInfo($address.scriptNode-status) 0
+                         eval \$widgetInfo($address.scriptNode-refreshStatus)                        
+                    }
+                    updateParent [join $address "." ]                     
+                }]                
+            }
+            
+        }        
+        
+        
+        # Require
+        set widgetInfo($address-requiredValue) ""
+        
+        if  {[dTree_attrExists $XMLtree  $full_address_XML_clean "require"]==1} {
+            set require [dTree_getAttribute_fast $XMLtree $full_address_XML_clean "require"]  
+            set possibleAddresses [dTree_searchNode $XMLtree $require]
+            if {[llength $possibleAddresses] != 1} {
+                set newNode "$initializedSolver $require"
+                set possibleAddresses [dTree_searchNode $XMLtree $newNode]
+                if {[llength $possibleAddresses] != 1} {
+                    error "Keywords $newNode have not given relevant results\n Results :\n $possibleAddresses"
+                }
+            }         
+            set widgetInfo($address-require)  [lindex $possibleAddresses 0]
+             
+	    switch [dTree_getAttribute_fast $XMLtree $widgetInfo($address-require) "nodeType"] {
+                 multiple {
+		    bind . <<treeChanged-[tree2gui $widgetInfo($address-require)]>> +[subst {
+			widget_require_multiple $win $address
+	    	    }]
+		 }
+		 default {
+		    bind . <<treeChanged-[tree2gui $widgetInfo($address-require)]>> +[subst {
+			widget_require_default $win $address 
+		    }]
+		 }
+            }
+	    # for initialisation of the require
+            event generate . <<treeChanged-[tree2gui $widgetInfo($address-require)]>>
+        }
+        
+	
+	
+	
+        # ExistIf
+        set widgetInfo($address-existIf) 0
+        if {[dTree_attrExists $XMLtree $full_address_XML_clean "existif"] ==1 } {
+            set widgetInfo($address-existIf) 1
+	    set existifArg [build_existIf_argument $full_address_XML_clean]
+            set widgetInfo($address-existIfArgument) [join [lindex $existifArg 0] " "]
+            set  widgetInfo($address-valuesToListen) [lindex $existifArg 1] 
+            
+            # Bind on all the values :
+            foreach addressToListen $widgetInfo($address-valuesToListen) {
+                set addr [tree2gui $addressToListen]
+		    bind . <<tmpTreeChanged-$addr>> +[subst {
+			widget_InquireVisibility $win $address
+                }]
+		# for initialization of the existif
+		event generate . <<tmpTreeChanged-$addr>>
+            }
+	}
+
+        
+        
+        
+        ################
+        # Creation of the nodes in the different trees
+        ################
+        
+        # Actual creation of the nodes
+	
+	if {[dTree_nodeExists $tmpTree "$nodes $name"]} {
+	    set default_value  [dTree_getAttribute $tmpTree "$nodes $name" "value" ]
+	    log "MWF : $name already exists ($default_value)"
+	    
+        } {
+	    dTree_addNode tmpTree $nodes $name    
+	    # Filling with default value or blank if no default specified
+	    set default_value [dTree_tryGetAttribute $XMLtree $full_address_XML_clean "default" ""]
+        }
+        
+	dTree_setAttribute tmpTree "$full_address_XML" "value" $default_value
+        set widgetInfo($address-variable) $default_value
+        set widgetInfo($address-default) $default_value
+        
+        # set validation behaviour to "onProcess" by default
+        # can be set to "automatic" for refresh-only widgets
+        switch $nodeType {
+            "info" -
+            "action" -
+            "multiple" {
+                set  widgetInfo($address-validateMode) "automatic"
+            }
+            default {
+                set  widgetInfo($address-validateMode) "onProcess"
+            }
+        }
+    }
+}
+
+proc finishWidget {} {
+    uplevel 1 { } {
+        # keep basic variables at hand
+        #set win $widgetInfo($address-win) 
+        #puts "finish : $win"
+        if {[winfo exists $win] && $widgetInfo($address-editable)==0} {
+            $win state disabled
+            foreach w [winfo children $win] {
+                $w state disabled
+            }
+        }
+        #####################
+        # Widget to tree
+        #####################
+        # Each time a widget changes (when user change a value in an entry for instance),
+        # The method widgetInfo($address-check) is called. It is componed by two parts :
+        #   The first part is the actual check by the widget itself, an entry is checking the type of the value for instance
+        #   The second part is not widget-specific. It adds the "widget2tree" behaviour and perform a refreshStatus, this is the code below
+        
+	
+	set widgetInfo($address-check) [subst {
+	    $widgetInfo($address-check)
+	    tail_Check $win $address
+	}]
+        
+        
+        #####################
+        # tree to widget
+        #####################
+        # Sometimes, a widget needs to update its value from the tree,
+        # This is done by the method widgetInfo($address-refresh) which code is below
+        
+	
+	# CRITICAL AD Dec 2014
+	# CE EXIST IF etait present avant le refactoring 
+	# JE ME DEMANDE PKOI IL EST NECESSAIRE
+	# pas de raison a priori
+	# COMMENTE POUR L'INSTANT
+	
+	# DE MEME LE EVAL DU CHECK EST MAINTENANT STATIQUE
+	
+	set widgetInfo($address-refresh) [subst {
+	    head_Refresh $win $address
+	    $widgetInfo($address-refresh)
+	    if {$widgetInfo($address-existIf) == 1} {
+		widget_InquireVisibility $win $address
+	    }
+	    $widgetInfo($address-check)
+	}]
+	
+	
+	
+	
+	
+        
+        
+        #####################
+        # refresh status
+        #####################
+        # Normally, each widget should have a method called widgetInfo($address-refreshStatus) which displays the status
+        # of the node to the user.
+        # As this method is widget-dependant, there is no code below
+        # This method is called by manageStatus
+        set adding [subst {
+            event generate . <<statusChanged-$address>>
+        }]
+        set widgetInfo($address-refreshStatus) "$widgetInfo($address-refreshStatus) $adding"
+        
+	
+	
+	
+	# necessary to rescale the multiple packing
+        set widgetInfo(fixedview) 1
+	event generate . <<SetView>>
+        set widgetInfo(fixedview) 0
+	
+	# check visibility at creation
+	#eval $widgetInfo($address-refresh)
+	
+	
+    }
+    
+    
+}
+
+################
+# updateParent
+################
+# This recursive procedure is called to update the status of each node, starting from a node
+#
+# An "end-widget" can have three status, valid (1), not valid (-1) or empty/unknown (0) before any action of the user
+# A container can have three status as well : false (-1) if one of its child is false, not validated (0) if all the children
+# are valid but the DStree is not up to date and valid (1) if the DStree is
+# General behaviour :
+# - If a widget's status changes and the parent was valid, parent has to turn its status into "not validated" 
+#
+# The procedure is called to apply a changing status
+
+proc updateParent {node} {
+    global widgetInfo
+    if {$node == ""} {return}
+    set status $widgetInfo($node-status)
+    if {$status != 0 } {
+        event generate . <<statusModified-$node>>    
+    }
+        set widgetInfo($node-status) 0
+        eval $widgetInfo($node-refreshStatus)
+    updateParent [join [lrange [split $node .] 0 end-1] . ]
+
+}
+
+################
+# CheckValidationStatus
+################
+# This recursive procedure is called to get the status of a node considering all the branch starting from the node
+# By calling this procedure, a node cannot be "not validated" anymore, its status is set to false if only one element from its branch is false
+# Otherwise, it is set to valid
+
+proc CheckValidationStatus {node  {rank 0}} {
+       
+    global widgetInfo tmpTree DStree
+    set childrenStatus ""
+    set children [dTree_getUsedChildren $tmpTree [gui2tree $node]]
+    
+    
+    
+    
+    # case of no children
+    if {[llength $children] == 0} {
+        set status $widgetInfo($node-status)
+    # case of children
+    } else {
+	foreach child $children {
+	    lappend childrenStatus [CheckValidationStatus "$node.$child" [expr $rank+1]]
+	}
+	set status [expr min([join $childrenStatus ,])]
+	
+	# When loading, some nodes, which weren't processed have a status equal to 1 at this point,
+	#so if they don't exist in the DStree their status is turned to 0. However, items in the DStree
+	# and in the tmpTree haven't the same name, so we check that there is no item_* in the address
+	if {$status==1 && ![dTree_attrExists $DStree [gui2tree $node] value] && [lsearch [gui2tree $node] "item_*"] == -1 } {
+	    set status 0
+	}
+
+	set widgetInfo($node-status) $status
+	eval $widgetInfo($node-refreshStatus)
+	set status $widgetInfo($node-status)
+
+    }
+    
+    
+    
+    # in all cases , to update potential requires and existifs...
+    if {$status == 1} {
+	event generate . <<treeChanged-$node>>
+    }
+    return $status
+
+}
+
+################
+# UpdateValidationStatus
+################
+# This procedure is called to set the status of the ancestors after a validation
+# It acts like the CheckValidationStatus procedure but upward, for one leved (not recursive by itself)
+proc UpdateValidationStatus {node} {
+    global widgetInfo tmpTree
+    foreach address [addrGetAncestors $node] {
+        set childrenStatus ""
+        set children [dTree_getChildren_fast $tmpTree [gui2tree $address]]
+        #if {[llength $children] == 0} {
+        #    #Here, it is a security but it should never happen as this procedure is called by one of the children
+        #    #tk_messageBox -title "Spacio-temporal problem" -message "It seems that there is a problem that should have never happened!\nCauses could be :\n- There is a giant black hole about to destroy earth, then you should run for your life instead of using this software\n- There was a change in the internal structure of this soft and you should contact the developpers about it."
+        #    error "Bug : UpdateValidationStatus has been called by $node whose father is $address\n But problem : $node is not considered as a child of $address"
+        #    continue
+        #}
+        
+        foreach child $children {
+            lappend childrenStatus $widgetInfo($address.$child-status)
+        }
+        
+        set status [expr min([join $childrenStatus ,])]
+	#debug "UpdateValidationStatus : $status ($address  / $node)"
+        set widgetInfo($address-status) $status
+        eval $widgetInfo($address-refreshStatus)
+    }
+}
+
+################
+# Validation
+################
+# Using the procedures above, here is a validation procedure. It needs an address to start from.
+
+proc Validate {win address} {
+    global widgetInfo tmpTree DStree
+    
+    #debug "Validate  $address $widgetInfo($address-status)"
+    
+    set treeAddress [gui2tree $address]
+    # Create the node corresponding to address if it does not exist
+    if {![dTree_nodeExists $DStree $treeAddress]} {
+        dTree_addNode DStree [lrange $treeAddress 0 end-1] [lindex $treeAddress end]
+    }
+    
+    # remove corresponding branch from the DStree
+    dTree_rmBranch DStree $treeAddress
+    
+    # Copy branch from the tmpTree to the DStree
+    dTree_copyRelevantBranch tmpTree $treeAddress DStree [gui2tree [addrGetFather $address]]
+    
+    # If exists, run the script
+    if {[info exists widgetInfo($address-scriptAddress)] && $widgetInfo($address-status) == 1} {}
+    if {[info exists widgetInfo($address-scriptAddress)] } {    
+        openPipe $win $address
+    } else { 
+        # Umbrella backward  then upward
+        CheckValidationStatus $address
+        UpdateValidationStatus $address
+    }
+    
+  
+}
+
+
+################
+# RefreshFamily 
+################
+# This procedure is used to refresh all the widgets with a common ancestor (node) to be refreshed with tmpTree values
+# !! Correction : in the refresh callback , there is
+#   head_refresh : DStree >> Variable
+#   tail_check : Variable >> tmpTree
+proc RefreshFamily {node} {
+    global tmpTree widgetInfo DStree
+ 
+    #puts "RefreshFamily $node : $widgetInfo($node-refresh)"
+    eval $widgetInfo($node-refresh)
+    foreach child [dTree_getChildren_fast $tmpTree [gui2tree $node]] {
+        RefreshFamily "$node.$child"
+    }
+
+}
+
+
+###############
+# CheckFamily 
+################
+# This procedure is used to check all the widgets with a common ancestor (node) to be refreshed with tmpTree values
+# !! Correction : in the check callback , there is ONLY 
+#   tail_check : Variable >> tmpTree
+
+
+proc CheckFamily {node} {
+    global tmpTree widgetInfo
+    #puts "CheckFamily $node : $widgetInfo($node-refresh)"
+    
+    eval $widgetInfo($node-check)
+    foreach child [dTree_getChildren_fast $tmpTree [gui2tree $node]] {
+        CheckFamily "$node.$child"
+    }
+}
+
+################
+# this procedure is used in the case of additive widgets : tabs, raddiobutton, modelxor, etc...
+# instead of InitWidget. See the radiobox widget for a clean example
+################
+proc getinfoFatherWidget {} {
+    uplevel 1 {
+    # Get access to the central data tree
+        global DStree
+        global XMLtree
+        global GuiInfo
+        global widgetInfo
+        
+        read_arguments
+        
+        set address_father [join $nodes "."]
+        set win_father $widgetInfo($address_father-win)
+    }
+}
+
+########################
+# utilitie to clean the memory on widget destruction
+#######################
+proc cleanWidgetMemory { address} {
+    global widgetInfo DStree
+
+    #remove all GUI memory
+    foreach item [array names widgetInfo "$address-*"] {
+        unset widgetInfo($item)
+    }
+    # remove all XML memory
+    dTree_rmBranch tmpTree [split $address .]
+
+}
+
+
+###########
+# Require procs
+###########
+
+proc widget_require_multiple {win address}  {
+    global widgetInfo DStree
+    
+    # skip if element is not existing
+    if {[array names widgetInfo $address-require] == ""} {return}
+	
+    set multipleChildren [dTree_getChildren_fast $DStree $widgetInfo($address-require) ]
+    set requiredValue ""
+    foreach child $multipleChildren {
+	lappend requiredValue [dTree_getAttribute_fast $DStree [concat $widgetInfo($address-require) $child] "value"]
+    }
+    if {$requiredValue != $widgetInfo($address-requiredValue)} {
+	set widgetInfo($address-requiredValue) $requiredValue
+	eval $widgetInfo($address-refresh)
+    }
+}
+
+
+proc widget_require_default {win address}  {
+    global widgetInfo DStree
+    
+    # skip if element is not existing
+    if {[array names widgetInfo $address-require] == ""} {return}
+    
+    set requiredValue [split [dTree_tryGetAttribute_fast $DStree $widgetInfo($address-require) "value" ""] ";"]		 
+    if {$requiredValue != $widgetInfo($address-requiredValue)} {
+	set widgetInfo($address-requiredValue) $requiredValue
+	eval $widgetInfo($address-refresh)
+    }
+}
+
+#############
+# EXistif procs
+#############
+
+proc widget_InquireVisibility {win address} {
+    global widgetInfo tmpTree
+	# skip if not existing
+	if { [catch {set dummy  $widgetInfo($address-visible)}]} {return}
+	set oldVisibility $widgetInfo($address-visible)
+    if {[expr $widgetInfo($address-existIfArgument)]} {
+		if {$oldVisibility == 0} {
+			set widgetInfo($address-visible) 1
+			eval $widgetInfo($address-check)
+			event generate . <<visiblityChanged-$address>>
+		}
+	} else {
+		if {$oldVisibility == 1} {
+			set widgetInfo($address-visible) 0
+			eval $widgetInfo($address-check)
+			event generate . <<visiblityChanged-$address>>
+		}
+		
+    }
+
+}
+
+proc build_existIf_argument {full_address_XML_clean} {
+    global XMLtree initializedSolver
+    set rawExistif [dTree_getAttribute_fast $XMLtree $full_address_XML_clean "existif"]
+    set rawExistif [split $rawExistif "#"]
+    
+    set listExistif ""
+    set valuesToListen ""
+    
+    if {[expr [llength $rawExistif] % 2] != 1 } {error "[join $rawExistif {"#"}] is not well-formed"}
+    for {set i 0} {$i < [llength $rawExistif]} {incr i} {
+	if {$i % 2 == 1} {
+	    # Assuming this member of the list is an adress to parse
+	    # foreach address to parse, replacing keywords by actual address
+	    set AddressToParse [lindex $rawExistif $i]
+	    set possibleAddresses [dTree_searchNode $XMLtree $AddressToParse]
+	    
+	    # FISHY , Guillaume c'est quoi ca????
+	    if {[llength $possibleAddresses] != 1} {
+		set newNode "$initializedSolver $AddressToParse"
+		set possibleAddresses [dTree_searchNode $XMLtree $newNode]
+		if {[llength $possibleAddresses] != 1} {
+		
+		    error [subst {"In node : $full_address_XML_clean,  Keywords $newNode have not given relevant results\n Results :\n $possibleAddresses"}]
+		}
+	    }
+	    lappend listExistif [subst {\[dTree_tryGetAttribute_fast \$tmpTree "[lindex $possibleAddresses 0]" "value" "existIf element not found"]}]
+	    lappend valuesTolisten [lindex $possibleAddresses 0]
+	    
+	} else {
+	    lappend listExistif [lindex $rawExistif $i]
+	}
+    }
+    return [list $listExistif $valuesTolisten]
+    
+}
+
+#############
+# Decorateurs Refresh et Check
+#############
+
+
+
+# Le check compare la variable a ce qu'on trouve dans le tmpTree
+# Si pas pareil, le tmpTree recoit la variable
+# + l'evenement tmptree changed est emis
+
+proc  tail_Check {win address} {
+    global tmpTree widgetInfo
+    set full_address_XML [split $address "."]
+    set nodes [lrange $full_address_XML 0 end-1 ]
+    set tree_value [dTree_getAttribute_fast $tmpTree $full_address_XML "value"]
+    if { $tree_value != $widgetInfo($address-variable) || $widgetInfo($address-variable) == ""} {
+	dTree_setAttribute tmpTree $full_address_XML "value" $widgetInfo($address-variable)
+	event generate . <<tmpTreeChanged-$address>>
+	# necessaire pour dire aux parents que le statu a change
+	updateParent [join $nodes .]    
+    }
+    eval $widgetInfo($address-refreshStatus)
+}
+
+
+
+# Le refresh cherche une valeur dans DSTREE
+# si elle y est, il l'envoie dans la variable GUI
+
+proc head_Refresh {win address} {
+    global widgetInfo DStree
+
+    set full_address_XML [split $address "."]
+	
+    if {[dTree_attrExists_fast $DStree $full_address_XML "value"]} {
+	set widgetInfo($address-variable) [dTree_getAttribute_fast $DStree $full_address_XML "value"]
+    }
+#    if {$widgetInfo($address-require) != ""} {
+#	set reqAddress [tree2gui $widgetInfo($address-require)]
+#    }   
+}    
+    
+ 
+
+########################
+# utilitie to clean the check refresh and refreshStatus of destroyed widget in the requires
+#######################
+
+proc widget_destroy {win address} {
+    global widgetInfo
+    set widgetInfo($address-refresh) ""
+    set widgetInfo($address-refreshStatus) ""
+    set widgetInfo($address-check) ""
+	bind . <<tmpTreeChanged-$address>> ""
+	bind . <<TreeChanged-$address>> ""
+	bind . <<statusModified-$address>> ""
+	bind . <<visiblityChanged-$address>> ""
+}
+
+
+
+
+# Note
+
+# Refresh callback
+#   1 head_refresh  : DStree >> widgetInfo
+#   SPECIFIC
+#   2 visibility issues
+#   3 tail_check : vairable >> tmpTree
+
+# Check callback
+#   SPECIFIC
+#   1 tail_check : variable >> tmpTree
+
+# refreshStatus callback
+#  SPECIFIC
+#	set widgetInfo(fixedview) 1
+#        event generate . <<SetView>>
+#        set widgetInfo(fixedview) 0
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/openpipe.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/openpipe.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/openpipe.tcl	(revision 4775)
@@ -0,0 +1,212 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc openPipe {win address} {
+    global widgetInfo codesPath tmpTree metaTree loadedProject workingDir configTree configPath
+    
+    Start_think "stopScript $win $address"
+    
+    #$win.action.progress start
+    
+    # Check that project has been been saved at least once, otherwise, quit
+    if {$loadedProject == "none"} {
+        log "The project needs to be saved first"
+        #tk_messageBox -message "The project first needs to be saved " -type ok -icon warning
+        Save_XML_File "new"
+    }
+    
+    if {$loadedProject == "none" || $loadedProject == ""} {
+        warning "The project is not savec. Aborting..."
+        Stop_think normal
+        return
+    }    
+    
+    saveDataset "dataset.xml" $address
+    
+    
+    # Detects type of script
+    set script $widgetInfo($address-scriptAddress)
+    set ext [file extension $script]
+    set pythonInterpreter "python"
+    if {[getConfig "config gui python interpreter"] == "user_specific"} {
+        set pythonInterpreter [getConfig "config gui python user_specific interpreter"]
+        log "python interpreter is now : $pythonInterpreter"
+    }
+    switch $ext {
+        ".py" {
+            execScript $win $address $pythonInterpreter
+        }
+        ".tcl" {
+           # set execCommand "wish $script"
+            execScript $win $address "tclsh" 
+        }
+        
+        default {
+           # set execCommand $script
+            debug "not implemented yet"
+        }
+    }
+    
+    
+#    if { [catch {tk_exec $execCommand} error_id] } {
+#        debug $error_id
+#        #debug $returnScript
+#        set widgetInfo($address-status) 0
+#        $win.action.progress stop
+#        return
+#    } else {
+#        #debug $returnScript
+#        
+#    }
+    
+    #set widgetInfo($address-status) 1
+    
+    #$win.action.progress stop
+    
+    #action_check $win $address
+    
+    
+}
+
+proc execScript {win address interpreter} {
+    global widgetInfo codesPath initializedSolver
+    # If the stop file already exists delete it !
+    # Apparently deprecadted
+    #if {[file exists [file join $initializedSolver stop_[file tail [file rootname $widgetInfo($address-scriptAddress)]]]]} {
+    #    file delete [file join $initializedSolver stop_[file tail [file rootname $widgetInfo($address-scriptAddress)]]]
+    #}
+    eval $widgetInfo($address-onScriptStarts)
+    
+    
+    if {$widgetInfo($address-cancellation) } {
+        log "cancellation of $address"
+        return
+    }
+    set os $::tcl_platform(os)
+    if {$os == "Windows NT"} {
+        #set execCommand "cmd \"$interpreter $widgetInfo($address-scriptAddress)\" "
+        set execCommand "$interpreter $widgetInfo($address-scriptAddress) $widgetInfo($address-args)"      
+    } else {
+        set execCommand "$interpreter $widgetInfo($address-scriptAddress) $widgetInfo($address-args)"
+    }    
+    
+    #log "\"$execCommand\" is now running"
+    set widgetInfo($address-starttime) [clock milliseconds]
+    set widgetInfo($address-actionChan) [open "| $execCommand" "r+"]
+    fileevent $widgetInfo($address-actionChan) readable "readPipe $win $address" 
+}
+
+proc readPipe {win address} {
+    global widgetInfo DStree metaTree
+    if {[gets $widgetInfo($address-actionChan) line] >= 0} {
+        if {[regexp {^%\d{1,3}%.*$} $line]} {
+            set line [split $line "%"]
+            set percent [lindex $line 1]
+            set message [join [lrange $line 2 end] "%"]
+            set widgetInfo($address-progressValue) $percent
+            set widgetInfo($address-status_txt) $message
+            eval $widgetInfo($address-updateProgress)
+        } else {
+            set tagid "none"
+            if {[string match "Ok*" $line]} { set tagid "ok"}
+            if {[string match "Error*" $line]} { set tagid "warning"}
+            if {[string match "Note*" $line]} { set tagid "debug"}
+            if {[string match "XDRExecute*" $line]} {
+                set tagid "xdrexecute"
+                set line [string map "XDRExecute >" $line]
+            }
+            log $line $tagid
+        }
+        
+    } else {
+        # Normal end
+        success "Script $widgetInfo($address-scriptAddress) is completed."
+        if {[catch {close $widgetInfo($address-actionChan) } err] } {
+            warning "Error in script $widgetInfo($address-scriptAddress) :\n$err"
+            set widgetInfo($address-status) 0   
+            set scriptStatus 0
+        } elseif {![file exists "out_dataset.xml"]} {
+            warning "No information found about this action. \n  Possible Causes \n - finish() statement not reached \n - permission denied on filesystem \n - disk quota exceeded \n\n Graphical application might behave erratically from now on..."
+            
+            set widgetInfo($address-status) 0   
+            set scriptStatus 0            
+        } else {
+            set widgetInfo($address-status) 1
+            loadDataset "out_dataset.xml"
+            file delete "out_dataset.xml"    
+            set scriptStatus [dTree_getAttribute $metaTree "root meta scriptSuccess" "value"]                  
+        }
+          
+        
+        #set dummyTree ""
+        #dTree_init dummyTree
+        #parseFile "out_dataset.xml" dummyTree "" "DStree"
+        
+        
+        #dTree_copyBranch dummyTree [gui2tree $address] DStree [lrange [gui2tree $address] 0 end-1]
+        # We need to reconstruct interface (multiple which depends on an unknown list have to be initialized)
+        #initializeNode tree "root"
+        #RefreshFamily $address
+        #RefreshFamily "root"
+        #CheckValidationStatus $address
+        #action_check $win $address
+        set widgetInfo($address-endtime) [clock milliseconds]
+        if {$scriptStatus == "0"} {
+            eval $widgetInfo($address-onScriptStops)            
+        } else {
+            eval $widgetInfo($address-onScriptEnds)
+        }
+        
+        Stop_think normal
+        
+    }
+}
+
+proc stopScript {win address} {
+    global codesPath widgetInfo debug
+    
+    warning "Trying to stop script. Zombies process can still be running. Beware !!!"
+#    debug "writing [file join $codesPath stop_[file tail [file rootname $widgetInfo($address-scriptAddress)]]]"
+#    set stopFile [open [file join $codesPath "stop_[file tail [file rootname $widgetInfo($address-scriptAddress)]]"] "w"]
+#    close $stopFile
+    set widgetInfo($address-endtime) [clock milliseconds]
+    
+    catch {close $widgetInfo($address-actionChan)} err
+    
+    eval $widgetInfo($address-onScriptStops)
+    
+} 
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/opentea.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/opentea.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/opentea.tcl	(revision 4775)
@@ -0,0 +1,506 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+set load_start_time [clock milliseconds]
+
+
+
+
+##############################################################
+# Handle  errors in thecode with a message                   #
+##############################################################
+proc popup_error {msg {type exitcontinue} } {
+    raise .
+    .startup.l configure -text  "Problem at startup\nClick here for more informations"
+    # Display a pop up for the user
+    set win ".popup"
+    set ierror 0
+    puts "################"
+    if {[winfo exists $win]} {
+        destroy $win
+    } 
+
+    switch $type {
+        "exitcontinue" {
+            puts "POPUP WARNING..."
+            puts $msg
+            set reply [tk_dialog $win "Error" $msg ""  0 exit continue]
+
+	    if {$reply == 0} {
+                exit
+            }
+        }
+        "strict" {
+            puts "POPUP ERROR..."
+            puts $msg
+            
+            tk_messageBox -icon error -message "$msg"
+            exit
+        }
+    }
+    
+}
+
+
+
+
+
+####################################
+# Read the arguments
+
+ttk::frame .startup
+ttk::label .startup.l -text "Starting up GUI..."
+pack .startup -fill both 
+pack .startup.l
+
+
+
+if {[expr [llength $argv] % 2] != 0} {
+    tk_messageBox -icon error -message "Error : arguments ($argv) are invalid."
+    exit
+}
+
+foreach { keyword argument } $argv {
+    # test keywords
+    if {![string match -* $keyword ]} {
+        tk_messageBox -icon error -message "Error : keyword must be like -*"
+        exit
+    }
+
+    set varname [ string trim $keyword "-"]
+    set listkeyword [list "code" "file" "config" "library" "plugins"]
+    if {$varname in $listkeyword} {
+        set key_$varname $argument
+    } else {
+	set listkey [join $listkeyword "\n-"]
+	#foreach $item $listkeyword {set listkey "$listkey \n $item"}
+        popup_error "Error : keyword -$varname is not recognized. \n Use one from \n \n-$listkey" strict
+        exit
+    }
+}
+
+
+
+####################################
+#Initialize variables
+
+
+
+global debug loading FunctionUsed solverList loadApplication configTree widgetInfo configPath pluginsPath starpack relaunchCmd
+global logHistory loadedProject metaTree requiredValue additionalWidgets
+global workingDir
+
+
+set workingDir [pwd]
+set configTree ""
+set loadApplication "none"
+set loadedProject "none"
+set abort_cmd ""
+set widgetInfo(SetViewMode)  "none"
+set widgetInfo(ReGrid)  "no"
+set widgetInfo(nregrid) 0
+set widgetInfo(form_to_update) ""
+set widgetInfo(tabfocus) ""
+set widgetInfo(fixedview) "1"
+set solverOrder(none) "0"
+set log_channel stdout
+
+
+
+set debug 1
+set wrapper 0
+set TraceProfile 1
+set tabscroll 1
+
+set ndim 3
+set requiredValue ""
+set widgetInfo(classApp) ""
+
+
+####################################
+# Initialize the pathes
+
+set pathEngine [file normalize [file dirname [info script]]]
+
+if {"vfs" ni [package names]} {
+    #The project has NOT been starpacked / classical behavior
+    set starpack 0
+    set topPath [file dirname $pathEngine ]
+    set relaunchCmd "[file normalize [info nameofexecutable]] [file normalize $argv0] "
+} else {
+    # The project has been starpacked
+    set starpack 1
+    set topPath [file dirname $starkit::topdir]
+    set relaunchCmd [file normalize [info nameofexecutable]]
+}
+
+# Gittag
+set gittag_file [file join $topPath "gittag"]
+if {[file exists $gittag_file ]} {
+    set engine_version [read [ open $gittag_file  ]]
+} else {
+    set engine_version "- No gittag -"
+}
+
+# Config
+#set configPath [file normalize [file join $topPath "myconfig.xml"]]
+if {[info exists key_config]} {
+    set configPathtmp [file normalize [file join [pwd] $key_config]]
+    if {[file exists $configPathtmp]} {
+	set configPath $configPathtmp
+    } else {
+	file copy -force $configPath $::env(HOME)
+	popup_error "The config file provided $configPathtmp does not exists. A template has been copied on your \$HOME." strict
+    }
+} else {
+    file copy -force $configPath $::env(HOME)
+    popup_error "You must specify a config file with -config option. A template has been copied on your \$HOME." strict
+}
+if {![file exists $configPath]} {
+    popup_error "Config file $configPath doesn't exist." strict
+}
+
+
+set relaunchCmd "$relaunchCmd -config $configPath"
+
+# library
+set libraryPath [file normalize [file join $topPath "library"]]
+if {[info exists key_library]} {
+    set libraryPath  [file normalize $key_library]
+    set widgetInfo(libraryPath)   $libraryPath
+
+}
+if {![file exists $libraryPath]} {
+    popup_error "Library folder $libraryPath does not exist." strict
+}
+
+set relaunchCmd "$relaunchCmd -config $configPath -library $libraryPath"
+
+# plugin
+set pluginsPath [file normalize [file join $topPath "library" "DATA" "pluginscripts"]]
+if {[info exists key_plugins]} {
+    set pluginsPath  [file normalize $key_plugins]
+    set widgetInfo(pluginsPath)  $pluginsPath
+
+}
+if {![file exists $pluginsPath]} {
+    popup_error "Plugins folder $pluginsPath does not exist." strict
+}
+
+set relaunchCmd "$relaunchCmd -config $configPath -plugins $pluginsPath"
+
+
+# XDR
+set XDRpath [file normalize [file join $topPath "XDRpy"]]
+if {![file exists $XDRpath]} {
+    popup_error "XDR folder $XDRpath does not exist." strict
+}
+
+
+####################################
+# Check if XDRpy folder is available in the the PYTHONPATH
+if {"PYTHONPATH" in [array names ::env]} {
+    puts "PYTHONPATH content at startup : $::env(PYTHONPATH)"
+    puts "XDRpy is expected at  : $XDRpath"
+    
+} else {
+    puts "Warning ,  PYTHONPATH variable not set, no link possible with XDRpy"
+    puts "The XDRpy library is expected to be located at \n: $XDRpath " 
+    puts "exiting..."
+    exit
+}
+    
+if { ![string match *XDRpy* $::env(PYTHONPATH)] } {
+    puts "Warning ,  no pattern XDRpy found in PYTHONPATH"
+    puts "The XDRpy library is expected to be located at : $XDRpath"
+    puts "exiting..."
+    exit
+}
+
+
+
+
+
+
+
+
+####################################
+# Load the procedures
+
+
+if {$wrapper==1} {
+    source [file join $pathEngine "wrapper.tcl"]
+} else {
+    source [file join $pathEngine "unwrapped.tcl"]
+}   
+
+source [file join $pathEngine "functions.tcl"]
+source [file join $pathEngine "functions_theme.tcl"]
+source [file join $pathEngine "functions_help.tcl"]
+source [file join $pathEngine "dTree.tcl"]
+source [file join $pathEngine "test_vartypes.tcl"]
+source [file join $pathEngine "create_gui.tcl"]
+source [file join $pathEngine "declare_icons.tcl"]
+source [file join $pathEngine "declare_faq.tcl"]
+source [file join $pathEngine "XMLparser.tcl"]
+source [file join $pathEngine "dTreeBrowser.tcl"]
+source [file join $pathEngine "treeAnalyser.tcl"]
+source [file join $pathEngine "create_entry.tcl"]
+source [file join $pathEngine "create_cluster.tcl"]
+source [file join $pathEngine "create_comment.tcl"]
+source [file join $pathEngine "create_comparator.tcl"]
+source [file join $pathEngine "create_action.tcl"]
+source [file join $pathEngine "create_choice.tcl"]
+source [file join $pathEngine "create_dynlist.tcl"]
+source [file join $pathEngine "create_graph.tcl"]
+source [file join $pathEngine "create_glance.tcl"]
+source [file join $pathEngine "create_info.tcl"]
+source [file join $pathEngine "create_emptyNode.tcl"]
+source [file join $pathEngine "create_multiple.tcl"]
+source [file join $pathEngine "create_metaTree.tcl"]
+source [file join $pathEngine "create_switch.tcl"]
+source [file join $pathEngine "create_browser.tcl"]
+source [file join $pathEngine "create_selection.tcl"]
+source [file join $pathEngine "create_tabs.tcl"]
+source [file join $pathEngine "create_main.tcl"]
+source [file join $pathEngine "create_modelframe.tcl"]
+source [file join $pathEngine "create_modelxor_light.tcl"]
+source [file join $pathEngine "create_solverframe.tcl"]
+source [file join $pathEngine "create_scrollform.tcl"]
+source [file join $pathEngine "create_switchform.tcl"]
+source [file join $pathEngine "create_status.tcl"]
+source [file join $pathEngine "create_timeline.tcl"]
+source [file join $pathEngine "create_window.tcl"]
+source [file join $pathEngine "create_viewer.tcl"]
+source [file join $pathEngine "color_utilities.tcl"]
+source [file join $pathEngine "metaWidget_functions.tcl"]
+source [file join $pathEngine "config.tcl"]
+source [file join $pathEngine "openpipe.tcl"]
+source [file join $pathEngine "recentProjects.tcl"]
+source [file join $pathEngine "genPyFromXMLtree.tcl"]
+source [file join $pathEngine "grapher_utilities.tcl"]
+source [file join $pathEngine "smartpacker.tcl"]
+source [file join $pathEngine "load_save.tcl"]
+
+
+if {[info exists additionalWidgets] == 0} {
+    set additionalWidgets ""
+}
+
+foreach widget $additionalWidgets  {
+    source [file join $pathEngine "SOURCES_PRIV" create_$widget.tcl]    
+}
+
+
+
+
+
+.startup.l configure -image  icon_gui_small -compound top
+
+
+#Build application list, then check
+set applicationList [glob -tails -type d -directory $libraryPath *]
+lremove applicationList DATA
+set widgetInfo(applicationList) $applicationList
+if {[info exists key_code]} {
+    if {[lsearch $applicationList $key_code] < 0} {
+	set listappl [join $applicationList "\n"]
+	popup_error "Application $key_code was not found in the library.\n\n Applications available are:\n$listappl." strict
+    }
+    set loadApplication $key_code
+}
+
+
+
+if {[info exists key_file]} {
+    set fileerror 0
+    if {[file extension $key_file] != ".xml"} {
+	set fileerror "File $key_file is not an XML file."
+    }
+    if {![file exists $key_file]} {
+	set fileerror "File $key_file was not found."
+    }
+    
+    if {$fileerror != 0 } {
+	set dir [file dirname $key_file]
+	
+	set listfile [join [glob -directory $dir "*.xml"] "\n"]
+	
+	set fileerror "$fileerror \n\n Other xml files in this directory are \n$listfile."
+	
+	popup_error $fileerror strict
+	exit
+    }
+    set loadedProject [file normalize $key_file]
+}
+
+
+# declare fonts (see function.tcl)
+font_create
+ThemeUpdate [ getConfig "config gui appearance theme"]
+
+
+
+############################
+# Creating the Application #
+############################
+
+
+if {$loadApplication == "none"} {
+    main_create
+    
+} else {
+    # make sure default solver is in solverList
+    if {[lsearch $applicationList $loadApplication] < 0} {
+	    tk_messageBox -icon error -message "Application $loadApplication was not found in the library.\nApplications available : [split $applicationList {, }]"
+	    exit
+    } 
+    
+    set modelPath [file normalize [file join $libraryPath $loadApplication XML]]
+    set codesPath [file join $libraryPath $loadApplication scripts]
+    set dataPath [file join $libraryPath]
+    
+    set startNode ""
+    set XMLtree ""
+    set tmpTree ""
+    set DStree ""
+    set metaTree ""
+    
+     
+    global DStree
+    global XMLtree
+    global tmpTree
+    global metaTree
+    
+   
+    
+    dTree_init DStree
+    dTree_init tmpTree
+    
+    fill_metaTree
+
+    
+    set browsemode [getConfig "config gui paths"]
+    if { $browsemode == "constant"} {
+	set workingDir [getConfig "config gui paths constant workingDir"]
+	if {![file exists $workingDir]} {
+	    popup_error "Constant working dir $workingDir doest not exists\nTo fix the pb, edit your file  $configPath \n with a valid path" strict
+	}
+    } else {
+        set workingDir [pwd]
+    }
+    
+    cd $workingDir
+    smartpacker_getconfig 
+    
+    
+    
+    OpenTeaXML2tree XMLtree $modelPath $dataPath
+   
+   
+    set nodes_to_skip ""
+    # Get the list of nodes to skip
+    set filename [file join $modelPath "nodes_to_skip" ]
+    if [file exists $filename ] {
+	set chout [ open $filename r ]
+	set content [ split [ read $chout] "\n" ]
+	close $chout
+	foreach line $content {
+	    if {$line != "" && [string index $line 0] != "#"} {
+		lappend nodes_to_skip $line
+	    }
+	}
+    }
+    
+    # Get the list of solvers to add
+    set solvers_to_add ""
+    set filename [file join $modelPath "solvers_to_add" ]
+    if [file exists $filename ] {
+	set chout [ open $filename r ]
+	set content [ split [ read $chout] "\n" ]
+	close $chout
+	foreach line $content {
+	    if {$line != "" && [string index $line 0] != "#"} {
+		lappend solvers_to_add $line
+	    }
+	}
+    }
+    
+    analyseModelTree XMLtree $nodes_to_skip $solvers_to_add
+    
+    if {[dTree_attrExists $XMLtree "root $loadApplication" "class"]} {
+         set widgetInfo(classApp) [dTree_getAttribute $XMLtree "root $loadApplication" "class"]        
+    }
+    log_create
+    Start_think ""
+    createWin .
+        
+    ttk::frame .main
+    pack .main -side left -fill both -expand true
+    set gui_win [gui_create -path ".main" -solver $loadApplication]
+    wm title . " [string toupper $loadApplication]"
+     
+    updateTitle    
+
+    
+    RefreshFamily "root"
+    update
+    
+    smartpacker_initialize_gui $loadedProject 
+    
+    
+    bind . <Escape> {+Stop_think abort}
+    bind . <Control-s> {Save_XML_File  "save"}
+    bind . <Control-h> {Window_help_generator}
+    bind . <Control-q> {quit_gui}
+    
+    
+    smartpacker_focus_correction
+    
+    
+    set load_stop_time [clock milliseconds]
+    set msgloadtime "Startup time :  [format "%0.3f" [expr { ($load_stop_time - $load_start_time)*0.001 }]] s."
+    log $msgloadtime
+
+    Stop_think normal
+}
+
+
+destroy .startup
+
+
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/recentProjects.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/recentProjects.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/recentProjects.tcl	(revision 4775)
@@ -0,0 +1,101 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+proc getRecentProjects {} {
+    global configPath
+    set recentPath [file join [file dirname $configPath] "recents.xml"]
+    # Test if the file already exists
+    if [file exists $recentPath] {
+        # Loads the file
+        set tree ""
+        dTree_init tree
+        parseFile $recentPath tree "" "DStree"
+        
+        # Transforms old recents.xml version into the new one
+        if {[dTree_nodeExists $tree "root recents"] == 0 } {
+            debug "dataset does not exist"
+            foreach child [dTree_getChildren $tree "root" ] {
+                dTree_moveBranch tree "root $child" tree "root recents"
+            }
+        }
+        
+        return $tree
+    } else {
+        # Create the file
+        set tree ""
+        dTree_init tree
+        dTree_addNode tree "root" "recents"
+        #saveXMLTree $recentPath $tree
+        return $tree
+    }
+}
+
+proc newRecentProject {XMLfile code} {
+    global topPath
+    set recentPath [file join $topPath "recents.xml"]
+    set XMLfile [file normalize $XMLfile]
+    # Test if the file already exists
+    
+        # Loads the file
+    set tree ""
+    dTree_init tree
+    
+    if [file exists $recentPath] {
+       parseFile $recentPath tree "" "DStree"
+        # Transforms old recents.xml version into the new one
+        if {[dTree_nodeExists $tree "root recents"] == 0 } {
+            
+            foreach child [dTree_getChildren $tree "root" ] {
+                dTree_moveBranch tree "root $child" tree "root recents"
+            }
+        }        
+       foreach elt [dTree_getChildren $tree "root recents"] {
+           if {[dTree_getAttribute $tree "root recents $elt" "path"] == $XMLfile} {
+               dTree_rmNode tree "root recents $elt"
+           }
+       }
+    } else {
+        dTree_addNode tree "root" "recents"
+    }
+    
+    set id [clock seconds]
+    dTree_addNode tree "root recents" $id
+    dTree_setAttribute tree "root recents $id" "path" $XMLfile
+    dTree_setAttribute tree "root recents $id" "code" $code
+    
+    #saveXMLTree $recentPath $tree
+
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/smartpacker.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/smartpacker.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/smartpacker.tcl	(revision 4775)
@@ -0,0 +1,456 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+proc smartpacker_getconfig {} {
+    global widgetInfo
+    set guiMode [getConfig "config gui appearance mode"]
+    if {$guiMode == ""} {
+        set guiMode "treeview"
+    }
+    set guiWidth [getConfig "config gui appearance width"]
+    if {$guiWidth == ""} {
+        set guiWidth "700"
+    }
+    set guiHeight [getConfig "config gui appearance height"]
+    if {$guiHeight == ""} {
+        set guiHeight "700"
+    }
+    
+    set widgetInfo(guimode) $guiMode
+    set widgetInfo(guiheight) $guiHeight
+    set widgetInfo(guiwidth) $guiWidth
+    switch $widgetInfo(guimode) {
+	"multicolumn" {
+	    set widgetInfo(guiSmallWidgetWidth)  [expr { int ([expr { 0.37*$widgetInfo(guiwidth)}])}]
+	    set widgetInfo(guiBigWidgetWidth) [expr { int ([expr { 0.74*$widgetInfo(guiwidth)}])}]
+	    set widgetInfo(guiEntryRelWidth)  0.5
+	}
+	"treeview" {
+	    set widgetInfo(guiSmallWidgetWidth)  [expr { int ([expr { 0.6*$widgetInfo(guiwidth)}])}]
+	    set widgetInfo(guiBigWidgetWidth) [expr { int ([expr { 0.6*$widgetInfo(guiwidth)}])}]
+	    set widgetInfo(guiEntryRelWidth)  0.33
+	}
+    }
+}
+
+
+# called at the start of the application to initiate the window
+
+proc smartpacker_initialize_gui { loadedProject } {
+    global widgetInfo
+    global workingDir
+    switch $widgetInfo(guimode) {
+	"multicolumn" {
+	    # bind the main window to the resizing action
+	    
+	    set widgetInfo(SetViewMode) "large"
+	    event generate . <<SetView>> 
+	    
+	    
+	    bind . <Configure> {
+		set ActualWidth [winfo width .]
+		#puts "AW $ActualWidth"
+		#puts "VM $widgetInfo(SetViewMode)"
+		
+		if {$ActualWidth >[expr { (2.2)*$widgetInfo(guiSmallWidgetWidth)}] && $widgetInfo(SetViewMode)=="small"} {
+		    set widgetInfo(SetViewMode) "large"
+		    event generate . <<SetView>> 
+		}
+		if {$ActualWidth >[expr { (3.3)*$widgetInfo(guiSmallWidgetWidth)}]  && $widgetInfo(SetViewMode)=="large"} {
+		    set widgetInfo(SetViewMode) "huge"
+		    event generate . <<SetView>> 
+		}
+		if {$ActualWidth <[expr { (2.2)*$widgetInfo(guiSmallWidgetWidth)}]  && $widgetInfo(SetViewMode)=="large"} {
+		    set widgetInfo(SetViewMode) "small"
+		    event generate . <<SetView>> 
+		}
+		if {$ActualWidth <[expr { (3.3)*$widgetInfo(guiSmallWidgetWidth)}]  && $widgetInfo(SetViewMode)=="huge"} {
+		    set widgetInfo(SetViewMode) "large"
+		    event generate . <<SetView>> 
+		}
+		
+		    
+	    }
+	}
+	"treeview" {
+	    
+	}
+    }
+    wm geometry . ${widgetInfo(guiwidth)}x${widgetInfo(guiheight)}
+    raise .
+    
+    if {$loadedProject != "none"} {      
+            loadProject $loadedProject
+    }
+    update    
+}
+
+# correction of focus on mac OSX
+proc smartpacker_focus_correction {} {
+    if {[getConfig "config gui appearance focusCorrection"] == 1} {
+	bind . <ButtonPress-1> {
+	    if {[focus] == ""} {
+		focus -force [focus -lastfor .]
+	    }
+	}
+    }
+    event generate . <<InitializeGUI>>
+}
+
+
+# smartpacker algorithm
+proc smartpacker_regrid {   } {
+    global widgetInfo
+    #log "regrid"
+    set viewmode $widgetInfo(SetViewMode)
+    
+
+    if {$widgetInfo(tabfocus) == ""} {
+	set $widgetInfo(tabfocus) [lindex $widgetInfo(form_to_update) 0]
+    }
+    if {$widgetInfo(tabfocus) == ""} {return} 
+    set win "$widgetInfo(tabfocus).sf.vport.form"
+    
+    switch $widgetInfo(guimode) {
+	"multicolumn" {
+	    #incr widgetInfo(nregrid)
+	    #puts "Regridding... $widgetInfo(nregrid) \n mode $viewmode"
+		
+	    set ColumnSize [expr { 1.1*$widgetInfo(guiSmallWidgetWidth)}]
+	    set VerticalPad 15
+	    set HorizontalPad [expr { 0.001*$widgetInfo(guiSmallWidgetWidth)}]
+	    set VerticalStart 5    
+	    set HorizontalStart 5
+	
+	    # get the number of columns
+	    switch $viewmode {
+		"small" {
+		    set colmax 1
+		}
+		"large" {
+		    set colmax 2
+		}
+		"huge" {
+		    set colmax 3
+		}
+		default {
+		    set colmax 1
+		}
+	    }
+	    
+	    update idletasks
+	    
+	    #list of widget to repack
+	    set widgetlist ""
+	    foreach wc [winfo children $win] {
+		if {[ winfo manager $wc ] != ""} {
+		    lappend widgetlist $wc
+		}
+	    }
+	    
+	    #  1st loop on widgets to fill info and depack widgets
+	    set wp(narrow-height) 0
+	    set wp(narrow-list) ""
+	    set wp(wide-list) ""
+	    foreach widget $widgetlist {
+	        eval $widgetInfo(unpackme-$widget)
+		
+		pack $widget 
+		
+		set wp($widget-height) [winfo reqheight $widget]
+		if {$wp($widget-height) == 0 }  {set wp($widget-height) [winfo height $widget]}
+		set wp($widget-width) [winfo reqwidth $widget]
+		if {$wp($widget-width) == 0 }  {set wp($widget-width) [winfo width $widget]}
+		
+		pack forget $widget
+			
+			
+			
+		if {$wp($widget-width)  < $ColumnSize} {
+		    incr wp(narrow-height)  $wp($widget-height)
+		    lappend wp(narrow-list) $widget
+		} else {
+		    lappend wp(wide-list) $widget
+		}
+		
+	    }
+	    
+		
+	    set vmax 0
+	    set hmax 0
+	    # balance the columns
+	    # if the middle of the widget is below the maximum average,
+	    # then the widget must jump one col
+	    set max [expr {int($wp(narrow-height)/$colmax*1.0)}]
+	    set position 0
+	    set mid_position 0
+	    set jumpwidget 0
+	    set sparecolumns $colmax 
+	    
+	    foreach widget $wp(narrow-list) { 
+		set  mid_position [ expr {int($position+ int(0.5*$wp($widget-height)))}]
+		if { $mid_position > $max &&  $sparecolumns > 1 } {
+		    set position 0
+		    set wp($widget-jump) 1
+		    incr sparecolumns -1
+		} else {
+		    set wp($widget-jump) 0
+		}
+		incr position $wp($widget-height)
+	    }
+	  
+	    
+	    # loop on narrow widgets
+	    set wp(x1) $HorizontalStart
+	    set wp(y1) $VerticalStart
+	    set wp(narrowtotalheight) 0
+	    foreach widget $wp(narrow-list) {
+		if {$wp($widget-jump)} {
+		    set wp(x1) [expr {int($wp(x1) + $HorizontalPad + $ColumnSize)}]
+		    set wp(y1) $VerticalStart
+		}
+                place $widget -x $wp(x1) -y $wp(y1) -width $wp($widget-width) -height $wp($widget-height)		
+		set widgetInfo(packme-$widget) [subst {
+		    set widgetInfo(fixedview) 1
+                    place $widget -x $wp(x1) -y $wp(y1) -width $wp($widget-width) -height $wp($widget-height)		
+		    event generate . <<SetView>>
+                    set widgetInfo(fixedview) 0
+                }]
+		set widgetInfo(unpackme-$widget) [subst {
+		    place forget $widget
+		}]
+		
+		
+		
+		incr wp(y1) $wp($widget-height)
+		incr wp(y1) $VerticalPad
+		if { $wp(narrowtotalheight) < $wp(y1) } { set wp(narrowtotalheight) $wp(y1)}        
+	    }
+	    set hmax [expr {int($wp(x1) + $HorizontalPad + $ColumnSize)}]
+	    
+	  
+	    #loop on wide widgets
+	    set wp(x1) $HorizontalStart
+	    set wp(y1) $wp(narrowtotalheight)
+	    foreach widget $wp(wide-list) {
+		place $widget -x $wp(x1) -y $wp(y1) -width $wp($widget-width) -height $wp($widget-height)
+		set widgetInfo(packme-$widget) [subst {
+                    set widgetInfo(fixedview) 1
+                    place $widget -x $wp(x1) -y $wp(y1) -width $wp($widget-width) -height $wp($widget-height)
+		    event generate . <<SetView>>
+                    set widgetInfo(fixedview) 0
+                }]
+		set widgetInfo(unpackme-$widget) [subst {
+		    place forget $widget
+		}]
+		
+		incr wp(y1) $wp($widget-height)
+		incr wp(y1) 5
+		set widthwide [expr {int($wp($widget-width) +$HorizontalStart+2*$HorizontalPad)}]
+		if { $widthwide > $hmax} {set hmax $widthwide}
+		
+	    }
+	    set vmax $wp(y1)
+	    
+	    
+	    # clean all variables used
+	    array unset wp
+	    
+	    # adjust the form
+	    $win configure -width $hmax -height $vmax
+	    set widgetInfo(ReGrid) "no"
+	    
+	    scrollform_resize [crop_address $win 2]
+	    
+	    
+	    
+	    
+	}
+	"treeview" {
+		
+	}
+	
+    }
+    
+    
+    
+}
+
+
+proc smartpacker_update_visibility { win address } {
+    global widgetInfo
+    if {$widgetInfo($address-existIf)} {
+        if {$widgetInfo($address-visible)}  {
+	    eval $widgetInfo(packme-$win)
+        } else {
+	    #debug "unpackme $win"
+            eval $widgetInfo(unpackme-$win)
+        }
+    }
+}
+
+# called when a modelframe is initiated, to keep the same layout for each frame
+proc smartpacker_setup_modelframe { win address } {
+    uplevel 1 {} {
+	
+	set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
+    
+	# main labelframe or frame in flat-style
+	switch -glob $style {
+	    "flat" {
+		ttk::frame $win
+	    }
+	    "group_of_models" {
+		ttk::frame $win
+		ttk::label $win.title -text $title -style "Model.TLabelframe.Label"
+		ttk::separator $win.sep  -orient horizontal
+		pack $win.title -side top
+		pack $win.sep -side top -fill x
+		
+	    }
+	    
+	    "onrequest" {
+		set widgetInfo($address-onrequest) 0
+		ttk::frame $win
+		
+		ttk::label $win.title -image icon_plus -compound left -text $title
+		
+		
+		ttk::separator $win.sep  -orient horizontal
+		pack $win.title -side top -anchor w
+		pack $win.sep -side top -fill x
+		ttk::frame $win.snap
+		bind $win.title <ButtonPress> [subst {
+		    if {\$widgetInfo($address-onrequest) == 0} {
+			set widgetInfo($address-onrequest) 1
+			pack $win.snap -side top -fill both
+			$win.title configure -image icon_minus
+			event generate . <<SetView>> 
+		    } else {
+			set widgetInfo($address-onrequest) 0
+			pack forget $win.snap
+			$win.title configure -image icon_plus
+			event generate . <<SetView>> 
+		    }
+		}]
+	    }
+	    "sublevel_*" {
+		set level [lindex [split $style "_" ] 1]
+		
+		if {$level < 1} {set level 1}
+		if {$level > 3} {set level 3}
+		set pad [expr { $level *20}] 
+		ttk::frame $win
+		label $win.title -text $title -image "bullet_$level" -compound left -bg [ThemeColor 1.0] -fg [ThemeColor [expr {$level*0.2}]]
+		#-style "Model.TLabelframe.Label"
+		ttk::separator $win.sep  -orient vertical
+		pack $win.sep -side left -fill y -padx "$pad 0" -pady 10
+		
+		    
+		
+		pack $win.title -side top -anchor w
+		
+	    }
+	    default {
+		ttk::labelframe $win -text $title -style "Model.TLabelframe"
+	    }
+	}
+	
+	eval $widgetInfo(packme-$win)
+	
+	ttk::frame $win.forceps -width $widgetInfo(guiSmallWidgetWidth) -height 0 
+	pack $win.forceps -side top 
+    }
+}
+
+# called when a simple widget is initiated, to keep the same label layout for each simple widget
+proc smartpacker_setup_label { win address } {
+    uplevel 1 {} {
+	set title "[dTree_getAttribute $XMLtree $full_address_XML "title"]:"
+	ttk::label $win.lbl -text $title -justify right
+    
+	if { $widgetInfo(guimode) == "multicolumn"} {
+	    $win.lbl configure -wraplength [expr { int(0.5*$widgetInfo(guiSmallWidgetWidth))}]
+	}    
+	
+	place $win.lbl -relx 0.5 -rely 0. -anchor ne
+    }
+}
+ 
+# called when a widget is initiated, to keep the same status layout for each simple widget
+proc smartpacker_setup_status { win address } {
+    uplevel 1 {} {
+	set widgetInfo($address-status) 0
+	set widgetInfo($address-status_txt) ""
+	ttk::label $win.status -textvariable widgetInfo($address-status_txt) -foreground "red" -justify center -compound left
+	$win.status configure -wraplength [expr { 0.6*$widgetInfo(guiSmallWidgetWidth)}]
+	place $win.status -relx 0.5 -rely 1 -anchor s
+    }
+}
+
+
+proc Start_think { cmd} {
+    global abort_cmd
+    
+    set abort_cmd $cmd
+    
+    . config -cursor watch
+    grab .log
+    update
+}
+
+proc Stop_think {  mode }  {
+    global abort_cmd
+    . config -cursor left_ptr
+    grab release .log
+    raise .
+    if {$abort_cmd == ""} {set mode "normal"}
+    switch $mode {
+	"normal" {
+	    
+	}
+	"abort" {
+	    warning "Aborting ..."
+	    eval $abort_cmd
+	}
+	default {
+	    error "Wrong use of stop_think"
+	}
+    }
+    update
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/test_vartypes.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/test_vartypes.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/test_vartypes.tcl	(revision 4775)
@@ -0,0 +1,321 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+
+
+# catch error using :
+# if { [test_vartype] != 1}
+proc test_vartype {value type} {
+    global ndim
+    switch -glob $type {
+        "integer*" {
+            if { [string is integer $value ] } {
+                set test_result 1
+            } else {
+                set test_result "\"$value\" not integer"
+            }
+            if {$test_result==1 && [string match "integer_*" $type]} {
+                set test_result [test_vartype_conditions $value $type]
+            }
+        }
+        "double*" {
+            if { [string is double $value ] || [string is integer $value]} {
+                set test_result 1
+            } else {
+                set test_result "\"$value\" not real"
+            }
+            
+            if {$test_result==1 && [string match "double_*" $type]} {
+                
+                set test_result [test_vartype_conditions $value $type]
+            }
+        }
+        "vector" {
+        # THE USE OF VECTOR IS DEPRECATED - Remains  for bckward Compatibility
+            set test_result 1
+            if {[llength $value] != $ndim } {
+                set test_result "\"$value\" is not a $ndim-dimension vector"
+            } else {
+                foreach component $value {
+                    if {  [string is double $component ] == 0 } {
+                        set test_result "\"$component\" not real"
+                    }
+                }
+            }
+        }
+        "date" {
+             set test_result 1
+            if { [string length $value] != 8 } {
+                set test_result "\"$value\" is not in jj/mm/aa format"
+            } else {
+                set jj [string range $value 0 1]
+                set sep [string index $value 2]
+                set mm [string range $value 3 4]
+                set sep2 [string index $value 5]
+                set aa [string range $value 6 7]
+                
+                
+                if {$sep != "/" || $sep2 != "/" } {
+                    set test_result "Date separator must be \/"
+                    return $test_result
+                }
+                
+                if {![string is integer $jj] || ![string is integer $mm] || ![string is integer $aa]} {
+                   set test_result "One of  jj/mm/aa is not an integer"
+                   return $test_result
+                } 
+                
+                if {$jj < 1 || $jj > 31 } {
+                   set test_result "Day must be btw 01 and 31"
+                   return $test_result
+                }
+                if {$mm < 1 || $mm > 12 } {
+                   set test_result "Month must be btw 01 and 12"
+                   return $test_result
+                }
+                
+                if {$aa < 13 || $mm > 99 } {
+                   set test_result "Year must be btw 13 and 99"
+                   return $test_result
+                }
+            }
+        }        
+        "fraction" {
+            if { [string is double $value ]
+                 && $value >= 0.0
+                 && $value <= 1.0
+                } {
+                set test_result 1
+            } else {
+                set test_result "\"$value\" not btw 0 and 1"
+            }
+        }
+        "string*" {
+            set test_result 1
+            if {[string is ascii $value ] == 0 } {
+                 set test_result "\"$value\" invalid (accents, special chars)"  
+            }
+            if {$test_result==1 && [string match "string_*" $type]} {
+                set test_result [test_vartype_conditions $value $type]
+            }
+            
+        }
+        "word" -
+        "ascii*" {
+            set test_result 1
+            if {[string is ascii $value ] == 0 } {
+                 set test_result "\"$value\" invalid (accents, special chars)"  
+            }
+            if { [llength $value] > 1} {
+                set test_result "\"$value\" invalid (blank spaces)"    
+            }
+            if {$test_result==1 && [string match "ascii_*" $type]} {
+                set test_result [test_vartype_conditions $value $type]
+            }
+        }
+        "liststring" {
+            if { [llength $value] > 0 } {
+                set test_result 1
+                foreach subvalue $value {
+                    if {![string is ascii $subvalue ]} {
+                        set test_result "\"$subvalue\" not ASCII"
+                        break
+                    }
+                }
+            } else {
+                set test_result "(...)"
+            }
+        }
+        "complex" {
+            set test_result [test_vartype_complex $value]
+        }      
+        default {
+            set test_result "Type \"$type\" unknown."
+        }
+    }
+    if {$value == ""} {
+        set test_result "(...)"
+    }
+    return $test_result
+}
+
+proc test_vartype_complex {c} {
+    # Test un seul ou pas de i
+    if {[llength [split $c "i"]] > 2 || $c == ""} {
+        return "Not complex number"
+    }
+    
+    set decomp [detection_structure_complex $c]
+   # puts "decomp : #$decomp#"
+    #Analyse of the result :
+    if {$decomp == "false" || $decomp == ""} {
+        return "Not complex"
+    }
+    
+    # Test of double vide ou i sur premire partie
+    if {[llength $decomp] == 2} {
+        if { [llength [split [lindex $decomp 0] "i"]] == 2 || [llength [split $c "i"]] == 1} {
+        return "Not complex"
+        }
+    }
+    
+    
+    foreach element $decomp {
+        set atester [string trimright $element "i"]
+        if {![string is double $atester] || $element == ""} {
+            return "Not complex"
+        }
+    }
+    
+    return 1
+}
+
+proc test_vartype_conditions {value type} {
+    set conditions [lrange [split $type "_"] 1 end]
+    foreach cond $conditions {
+        switch -glob $cond {
+            "ge*" {
+                set bound [string range $cond 2 end]
+                if {$value < $bound} {
+                    return "\"$value\" too small (min $bound)"
+                }
+                
+            }
+            "gt*" {
+                set bound [string range $cond 2 end]
+                if {$value <= $bound} {
+                    return "\"$value\" too small (min $bound)"
+                }
+                
+            }
+            "le*" {
+                set bound [string range $cond 2 end]
+                if {$value > $bound} {
+                    return "\"$value\"  too big (max $bound)"
+                }
+                
+            }
+            "lt*" {
+                set bound [string range $cond 2 end]
+                if {$value >= $bound} {
+                    return "\"$value\" too big (max $bound)"
+                }
+            }
+            "streq*" {
+                set bound [string range $cond 5 end]
+                if {[string length $value] > $bound} {
+                    return "\"$value\" too long (exactly $bound chars)"
+                }
+                if {[string length $value] < $bound} {
+                    return "\"$value\" too short (exactly $bound chars)"
+                }
+            }
+            "strmax*" {
+                set bound [string range $cond 6 end]
+                if {[string length $value] > $bound} {
+                    return "\"$value\" too long (max $bound)"
+                }
+            }
+            "strmin*" {
+                set bound [string range $cond 6 end]
+                if {[string length $value] < $bound} {
+                    return "\"$value\" too short (min $bound)"
+                }
+            }
+        
+        }
+    
+    
+    }
+    
+    return 1
+
+}
+
+proc detection_structure_complex {c} {
+    
+    # Nettoyage des elements
+    set splitted_p ""
+    foreach el [split $c "+"] {
+        lappend splitted_p [string trim $el]
+    }
+    set nb_split_p [llength $splitted_p]
+    
+    if {$nb_split_p==1} {
+        # Pas de + dans la chaine : split sur - ou simple nb
+    } elseif { $nb_split_p == 2 && [lindex $splitted_p 0]==""} {
+        # Simple nombre ou complexe separe par un -
+        
+    } elseif {$nb_split_p == 2} {
+        # Complexe de deux parties sans entourloupe
+        return $splitted_p
+    } elseif {$nb_split_p == 3 && [lindex $splitted_p 0] == ""} {
+        # Complexe  deux parties avec un plus au dbut
+        return [lrange $splitted_p 1 2]
+    } else {
+        # Ce n'est pas un complexe ...
+        return "false"
+    }
+    
+    # Si le script passe cette ligne, il y a, au plus, un + dans la chane
+    # Si il y a un +, alors il est au dbut comme dans "+3.4" ou "+3.4-8i"
+    
+    set splitted_m ""
+    foreach el [split $c "-"] {
+        lappend splitted_m [string trim $el]
+    }
+    
+    set nb_split_m [llength $splitted_m]
+    
+    if {$nb_split_m == 1} {
+        # Pas de moins ...
+        return [string trimleft [lindex $splitted_m 0] "+"]
+    } elseif {$nb_split_m == 2 && [lindex $splitted_m 0] == ""} {
+        # Simple nombre ngatif
+        return [lindex $splitted_m 1]
+    } elseif {$nb_split_m == 2} {
+        # Nombre complexe spar par un -
+        return [list [string trimleft [lindex $splitted_m 0] "+"] [lindex $splitted_m 1]]
+    } elseif {$nb_split_m == 3 && [lindex $splitted_m 0]== ""} {
+        # Nombre complexe  deux parties qui commence par un moins
+        return [list [lindex $splitted_m 1] [lindex $splitted_m 2]]
+    } else {
+        return "false"
+    }
+    
+}
+
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/treeAnalyser.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/treeAnalyser.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/treeAnalyser.tcl	(revision 4775)
@@ -0,0 +1,409 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+
+################################################################
+# This function analyses a parsed tree to
+#       - Fill attributes of nodes from a directory
+#       - Be sure keywords are well-formed
+#ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+proc analyseModelTree {itree nodes_to_skip solvers_to_add} {
+    global nodesToDelete libraryPath dataPath solverOrder
+    upvar $itree tree
+#    analyseModelNode tree "root"
+    
+    
+    # delete nodes if requested
+    foreach solver_to_add $solvers_to_add {
+        set solver [lindex $solver_to_add 0]
+        set order [lindex $solver_to_add 1]
+        
+        puts "## GRAFTING SOLVER $solver"
+        
+        set solverOrder($solver) $order
+        
+        set modelPath_add [file normalize [file join $libraryPath $solver XML]]
+        
+        OpenTeaXML2tree XMLtree_add $modelPath_add $dataPath
+        
+        # not necessary apparently, to be checked thoroughly if problems arise
+        #analyseModelTree XMLtree_add $nodes_to_skip ""
+        
+        dTree_copyBranch XMLtree_add "root $solver" tree "root"
+    }
+    
+    
+    
+    # Perform all inclusions 
+    set nodesToDelete ""
+    # Analyse each child
+    set childrenList [dTree_getChildren $tree "root"]
+   
+    foreach child $childrenList {
+        set childNode "root $child"
+        performInclusionForNode tree $childNode
+    }
+    set nodesToDelete [lsort -unique $nodesToDelete]
+    foreach address $nodesToDelete {
+        puts "Pruning branch $address"
+        dTree_rmBranch tree $address        
+    }    
+    
+    # delete nodes if requested
+    foreach node_to_skip $nodes_to_skip {
+        set resultsAddress [dTree_searchNode $tree $node_to_skip]
+        foreach address $resultsAddress {
+            dTree_rmBranch tree $address 
+        }
+    }
+    
+    
+    
+    # Analyse every node
+    set nodesToDelete ""
+    # Analyse each child
+    set childrenList [dTree_getChildren $tree "root"]
+    foreach child $childrenList {
+        set childNode "root $child"
+        analyseModelNode tree $childNode
+    }
+    set nodesToDelete [lsort -unique $nodesToDelete]
+    foreach address $nodesToDelete {
+        dTree_rmBranch tree $address        
+    }
+}
+
+
+proc performInclusionForNode {itree node} {
+    upvar $itree tree
+    global nodesToDelete
+    
+    # NodeType
+    if {[catch {set nodeType [dTree_getAttribute $tree "$node" nodeType]} ]} {
+        popup_error "no nodeType detected for the node $node. Please check your XML file system" strict
+    }
+    
+    ####################################
+    # Except "DATA" directory
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    if {$node == "root DATA"} {
+        return 0
+    }
+    
+    ####################################
+    # Perform inclusions when detecting "include"
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    if {$nodeType == "include"} {
+        # Be sure address is written
+        if {[catch {set addrInclude [dTree_getAttribute $tree "$node" "address"]}]} {
+            popup_error "No attribute -address- found in node : $node \n Please, be sure it is well written " strict
+        }
+        set resultsAddress [dTree_searchNode $tree $addrInclude]
+        set resultsCount [llength $resultsAddress]
+        if {$resultsCount == 0 } {popup_error "$addrInclude not found while reading node : $node\nPlease, be sure it well written" strict}
+        if {$resultsCount > 1} {
+           set resultsAddress [list [ lindex $resultsAddress 0]]
+        }
+        puts "Grafting branch $resultsAddress in [lrange $node end-2 end-1]" 
+        
+        # We are now sure the address is unique
+        set includeAddress [lindex $resultsAddress 0]
+        
+        # Delete the include node
+        dTree_rmBranch tree "$node"
+        
+        
+        dTree_copyBranch tree "$includeAddress" tree "[lrange $node 0 end-1]"
+        lappend nodesToDelete "$includeAddress"
+        return
+    }    
+    
+    ####################################
+    # Analyse each child for inclusion
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    set childrenList [dTree_getChildren $tree $node]
+    foreach child $childrenList {
+        set childNode "$node $child"
+        if {[dTree_nodeExists $tree $childNode]} {
+            performInclusionForNode tree $childNode
+        }
+    }    
+}
+
+
+
+
+
+
+
+################################################################
+# Recursive part of the analyseModelTree function
+#ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+proc analyseModelNode {itree node} {
+    upvar $itree tree
+    global nodesToDelete additionalWidgets
+    
+    
+    
+    
+    
+    # NodeType
+    if {[catch {set nodeType [dTree_getAttribute $tree "$node" nodeType]} ]} {
+        popup_error "no nodeType detected for the node $node. Please check your XML file system" strict
+    }
+    ####################################
+    # Except "DATA" directory
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    if {$node == "root DATA"} {
+        return 0
+    }
+    
+    
+   
+    
+    ####################################
+    # Add item node in the multiple
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ    
+    if {$nodeType == "multiple"} {
+        set multipleChildren [dTree_getChildren $tree $node]
+        dTree_addNode tree $node "item"
+        dTree_setAttribute tree "$node item" "nodeType" "item"
+        dTree_setAttribute tree "$node item" "name" "item"
+        dTree_setAttribute tree "$node item" "nodeType" "item"        
+        foreach child $multipleChildren {
+            dTree_moveBranch tree "$node $child" tree "$node item"            
+        }
+        
+    }
+    
+    
+    
+    set childrenList [dTree_getChildren $tree $node]
+    ####################################
+    # Fill attributes of directory nodes
+    # Move docu nodes to attribute of the father
+    # Include "include"
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    foreach child $childrenList {
+        # get name of the child if it exists
+        
+        if {![catch {set childName [dTree_getAttribute $tree "$node $child" name]}]} {
+            if {$childName == "folderParameters"} {
+                # If child's name is 'folderParameters'  ...
+
+                # ... Attributes from the child are stored ...
+                set childAttributes [dTree_getAttributes $tree "$node $child"]
+                
+                # ... into the father!
+                foreach attribute $childAttributes {
+                    if {[lindex $attribute 0] != "name"} {
+                        dTree_setAttribute tree "$node" [lindex $attribute 0] [lindex $attribute 1]
+                    }
+                }
+                
+                # Delete the child (love this one ...)
+                dTree_rmNode tree "$node $child"
+                
+            }
+        }
+        
+        if {$child == "docu"} {
+            dTree_setAttribute tree "$node" "docu" "[dTree_getAttribute $tree "$node docu" XMLContent]"
+            dTree_rmNode tree "$node docu"
+        }
+        
+        if {$child == "desc"} {
+            dTree_setAttribute tree "$node" "desc" "[dTree_getAttribute $tree "$node desc" XMLContent]"
+            dTree_rmNode tree "$node desc"
+        }
+        
+        
+        
+    }
+    
+    
+    ####################################
+    # Analyse elements of the node
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    
+    # A analyser :
+    # -Validit du nodeType
+    # -Prsence des attributs en fonction du nodeType
+    # -Default correspond  un des enfants
+    # - Place dans l'arbre
+    
+    
+    # NodeType
+    if {[catch {set nodeType [dTree_getAttribute $tree "$node" nodeType]} ]} {
+        popup_error "no nodeType detected for the node $node. Please check your XML file system"
+    }
+    set possibleNodeTypes "docu status solver tab comment comparator graph glance timeline viewer model xor action info param choice option multiple item" 
+    
+    foreach widget $additionalWidgets {
+        lappend possibleNodeTypes  $widget
+    }
+    
+    
+    if {[lsearch $possibleNodeTypes $nodeType] < 0} {
+        popup_error "$nodeType is not a valid nodeType for the node $node.\nIt has to be one of the following :\n$possibleNodeTypes" strict
+    }
+    
+    # Check attributes and depending on the nodeType
+    # quite loose for the moment.
+    
+    set checkName 1
+    set checkValue 0
+    
+    
+    if {$nodeType ni $possibleNodeTypes} {
+        error "You got to add the nodeType you invented in the switch in the tree analyser (where this message is emitted from)"
+    }
+    
+    switch $nodeType {
+        "docu" {
+            set checkName 0   
+        }
+        "status" {
+            set mandatoryArgs "name"
+            set optionalArgs "msgtrue msgfalse msgunknown default"
+        }
+        "solver" {
+            set mandatoryArgs "name title"
+            set optionalArgs "size"
+        }
+        "comment" {
+            set mandatoryArgs "name title"
+        }
+        "comparator" {
+            set mandatoryArgs "name title folder require"
+        }
+        "graph" {
+            set mandatoryArgs "name title"
+        }
+        "glance" {
+            set mandatoryArgs "name title"
+        }
+        "timeline" {
+            set mandatoryArgs "name title"
+        }
+        "tab" {
+            set mandatoryArgs "name title"
+            set optionalArgs "script existif custombutton"
+        }
+        "model" {
+            set mandatoryArgs "name title"
+            set optionalArgs "existif layout"
+        }
+        "xor" {
+            if {![catch {set defaultTemp [dTree_getAttribute $tree "$node" default]} ]} {
+                set children [dTree_getAttribute $tree "$node" children]
+                if {[lsearch $children $defaultTemp] < 0} {
+                    popup_error "In $node,\nThe 'default' attribute you specified can't be identified among the options : $children" strict
+                }
+            }
+            set optionalArgs "groups"
+        }
+        "param" {
+            set mandatoryArgs "name title type"
+            set optionalArgs "existif require fixed default filter ratio labels headings controls selection"
+            
+        }
+        "option" {
+            set checkName 0
+            set checkValue 1
+        }
+        "multiple" {
+            set mandatoryArgs "size"
+            
+        }
+        "include" {
+            set checkName 0
+            # But normally, the case is treated above
+        }
+        default {
+            
+        }
+    }
+    
+    # name presence
+    if {$checkName == 1 && [catch {set nameTemp [dTree_getAttribute $tree "$node" name]} ]} {
+        popup_error "no name detected for the node\n $node\n Please check your XML file system" strict
+    }
+    
+    # value presence
+    if {$checkValue == 1 && [catch {set valueTemp [dTree_getAttribute $tree "$node" value]} ]} {
+        popup_error "no value detected for the node\n $node\n Please check your XML file system" strict
+    }
+
+    # title presence, if not, copy name
+    if {[catch {set titleTemp [dTree_getAttribute $tree "$node" title]} ]} {
+        if {$checkName} {
+            dTree_setAttribute tree "$node" title [dTree_getAttribute $tree "$node" name]
+        }
+    }
+    
+    ####################################
+    # Analyse each child
+    #ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐ
+    set childrenList [dTree_getChildren $tree $node]
+    foreach child $childrenList {
+        set first_char [string index $child 0]
+         if {[string map {";" ""} $child ] != $child} {
+            popup_error "Semicolons (character ;) are not allowed for the node \n $node + $child \nPlease check your XML file system"   strict 
+        }
+        if {[string map {" " ""} $child ] != $child} {
+            popup_error "Spaces are not allowed for the node  \n $node + $child \nPlease check your XML file system" strict
+        }
+        # firstchar rule
+    
+        if {[string tolower $first_char] != $first_char} {
+            popup_error "Ill formed node :  uppercase letters are not allowed at the begginning of the node \n $node + $child \n Please check your XML file system" strict 
+        }
+        set forbidden_chars [list  "." "_"  ":" "?" "!"]
+        if {$first_char in $forbidden_chars} {
+            popup_error "Ill formed node :  nodes names cannot start with  punctuation marks \n $node + $child \n Please check your XML file system" strict 
+        }
+    
+     
+        
+        
+        
+        set childNode "$node $child"
+        if {[dTree_nodeExists $tree $childNode]} {
+            analyseModelNode tree $childNode
+        }
+    }
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/unwrapped.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/unwrapped.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/unwrapped.tcl	(revision 4775)
@@ -0,0 +1,42 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+rename proc _proc
+
+_proc proc {name args body} {
+    set ns [uplevel namespace current]
+    uplevel [list _proc $name $args $body]
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
Index: /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/wrapper.tcl
===================================================================
--- /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/wrapper.tcl	(revision 4775)
+++ /CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/wrapper.tcl	(revision 4775)
@@ -0,0 +1,57 @@
+#  This program is under CECILL_B licence. See footer for details.
+
+rename proc _proc
+
+
+_proc proc {name params body} {
+    global FunctionUsed
+    global FunctionTime
+    global TraceProfile
+    
+    
+    
+    set FunctionTime ""
+   
+    if { $name in "::tk::TearOffMenu ::tk::MenuDup Window_profiling Window_profiling_trace" } {
+        puts "skipping $name"
+    } else {
+        #puts "adding $name"
+        set FunctionUsed($name) 0
+        set body "global FunctionUsed \n global FunctionTime \n global TraceProfile \n if {\$TraceProfile} { \n incr FunctionUsed($name) \n lappend FunctionTime IN#$name#\[clock microseconds\] \n } \n $body \n \n if {\$TraceProfile} { \n lappend FunctionTime OUT#$name#\[clock microseconds\] \n }"
+    } 
+    _proc $name $params $body
+}
+
+
+#  Copyright CERFACS 2014
+#   
+#  antoine.dauptain@cerfacs.fr
+#   
+#  This software is a computer program whose purpose is to ensure technology
+#  transfer between academia and industry.
+#   
+#  This software is governed by the CeCILL-B license under French law and
+#  abiding by the rules of distribution of free software.  You can  use, 
+#  modify and/ or redistribute the software under the terms of the CeCILL-B
+#  license as circulated by CEA, CNRS and INRIA at the following URL
+#  "http://www.cecill.info". 
+#   
+#  As a counterpart to the access to the source code and  rights to copy,
+#  modify and redistribute granted by the license, users are provided only
+#  with a limited warranty  and the software's author,  the holder of the
+#  economic rights,  and the successive licensors  have only  limited
+#  liability. 
+#   
+#  In this respect, the user's attention is drawn to the risks associated
+#  with loading,  using,  modifying and/or developing or reproducing the
+#  software by the user in light of its specific status of free software,
+#  that may mean  that it is complicated to manipulate,  and  that  also
+#  therefore means  that it is reserved for developers  and  experienced
+#  professionals having in-depth computer knowledge. Users are therefore
+#  encouraged to load and test the software's suitability as regards their
+#  requirements in conditions enabling the security of their systems and/or 
+#  data to be ensured and,  more generally, to use and operate it in the 
+#  same conditions as regards security. 
+#   
+#  The fact that you are presently reading this means that you have had
+#  knowledge of the CeCILL-B license and that you accept its terms.
